{-# LANGUAGE CPP #-}{-# LANGUAGE OverloadedStrings #-}{-|
This module exports the 'Config' datatype which represents partially-specified
configurations of \"serve\" functions which run 'Snap' actions in 'IO'.
-}moduleSnap.Http.Server.Config(Config,ConfigListen(..),ConfigBackend(..),emptyConfig,defaultConfig,completeConfig,commandLineConfig,getHostname,getListen,getAccessLog,getErrorLog,getLocale,getBackend,getCompression,getVerbose,getErrorHandler,getDefaultTimeout,getOther,setHostname,addListen,setAccessLog,setErrorLog,setLocale,setBackend,setCompression,setVerbose,setErrorHandler,setDefaultTimeout,setOther)whereimportBlaze.ByteString.BuilderimportControl.Exception(SomeException)importControl.MonadimportqualifiedData.ByteString.UTF8asUimportqualifiedData.ByteString.Char8asBimportData.ByteString(ByteString)importData.CharimportData.ListimportData.MonoidimportPreludehiding(catch)importSnap.TypesimportSnap.Iteratee((>==>),enumBuilder)importSystem.Console.GetOptimportSystem.Environmenthiding(getEnv)#ifndef PORTABLEimportSystem.Posix.Env#endifimportSystem.ExitimportSystem.IO-------------------------------------------------------------------------------- | A data type to store the bind address and port to listen on.---- For SSL support, it also stores the path to the certificate in PEM format-- and the path to the private key in PEM formatdataConfigListen=ListenHttpByteStringInt|ListenHttpsByteStringIntFilePathFilePathinstanceShowConfigListenwhereshow(ListenHttpbp)="http://"++U.toStringb++":"++showpshow(ListenHttpsbpck)="https://"++U.toStringb++":"++showp++" (cert = "++showc++", key = "++showk++")"-------------------------------------------------------------------------------- | A data type to record which backend event loop should be used when-- serving data.dataConfigBackend=ConfigSimpleBackend|ConfigLibEvBackendderiving(Eq,Show)-------------------------------------------------------------------------------- | 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:---- > addListen (ListenHttp "0.0.0.0" 9000) 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'.dataMonadSnapm=>Configma=Config{hostname::MaybeByteString-- ^ The name of the server,listen::[ConfigListen]-- ^ The local interfaces to listen on,accessLog::Maybe(MaybeFilePath)-- ^ The path to the access log,errorLog::Maybe(MaybeFilePath)-- ^ The path to the error log,locale::MaybeString-- ^ The locale to use,backend::MaybeConfigBackend-- ^ The backend to use,compression::MaybeBool-- ^ Whether to use compression,verbose::MaybeBool-- ^ Whether to write server status updates to stderr,errorHandler::Maybe(SomeException->m())-- ^ A MonadSnap action to handle 500 errors,defaultTimeout::MaybeInt,other::Maybea-- ^ This is for any other state needed to initialize a custom server}------------------------------------------------------------------------------instanceMonadSnapm=>Show(Configma)whereshowc="Config {"++concat(intersperse", "$filter(/="")$map($c)[showM"hostname".hostname,showL"listen".listen,showM"accessLog".accessLog,showM"errorLog".errorLog,showM"locale".locale,showM"backend".backend,showM"compression".compression,showM"verbose".verbose,showM"errorHandler".fmap(const()).errorHandler,showM"defaultTimeout".fmap(const()).defaultTimeout])++"}"whereshowMs=maybe""((++)(s++" = ").show)showLsl=s++" = "++showl-------------------------------------------------------------------------------- | Returns a completely empty 'Config'. Equivalent to 'mempty' from-- 'Config''s 'Monoid' instance.emptyConfig::MonadSnapm=>ConfigmaemptyConfig=mempty------------------------------------------------------------------------------instanceMonadSnapm=>Monoid(Configma)wheremempty=Config{hostname=Nothing,listen=[],accessLog=Nothing,errorLog=Nothing,locale=Nothing,backend=Nothing,compression=Nothing,verbose=Nothing,errorHandler=Nothing,defaultTimeout=Nothing,other=Nothing}a`mappend`b=Config{hostname=(hostnameb)`mplus`(hostnamea),listen=(listenb)++(listena),accessLog=(accessLogb)`mplus`(accessLoga),errorLog=(errorLogb)`mplus`(errorLoga),locale=(localeb)`mplus`(localea),backend=(backendb)`mplus`(backenda),compression=(compressionb)`mplus`(compressiona),verbose=(verboseb)`mplus`(verbosea),errorHandler=(errorHandlerb)`mplus`(errorHandlera),defaultTimeout=(defaultTimeoutb)`mplus`(defaultTimeouta),other=(otherb)`mplus`(othera)}-------------------------------------------------------------------------------- | These are the default values for all the fields in 'Config'.---- > hostname = "localhost"-- > listen = []-- > accessLog = "log/access.log"-- > errorLog = "log/error.log"-- > locale = "en_US"-- > backend = Nothing (the backend is selected based on compile options)-- > compression = True-- > verbose = True-- > errorHandler = prints the error message--defaultConfig::MonadSnapm=>ConfigmadefaultConfig=Config{hostname=Just"localhost",listen=[],accessLog=Just$Just"log/access.log",errorLog=Just$Just"log/error.log",locale=Just"en_US",backend=Nothing,compression=JustTrue,verbose=JustTrue,errorHandler=Just$\e->doleterr=U.fromString$showemsg=mappend"A web handler threw an exception. Details:\n"errfinishWith$setContentType"text/plain; charset=utf-8".setContentLength(fromIntegral$B.lengthmsg).setResponseStatus500"Internal Server Error".modifyResponseBody(>==>enumBuilder(fromByteStringmsg))$emptyResponse,defaultTimeout=Just60,other=Nothing}-------------------------------------------------------------------------------- | Completes a partial 'Config' by filling in the unspecified values with-- the default values from 'defaultConfig'. Also, if no listeners are-- specified, adds a http listener on 0.0.0.0:8000completeConfig::MonadSnapm=>Configma->ConfigmacompleteConfigc=caselistenc'of[]->addListen(ListenHttp"0.0.0.0"8000)c'_->c'wherec'=mappenddefaultConfigc-------------------------------------------------------------------------------- | A data structure used during command-line option parsing---- The Config data type allows a list of listen ports, but the command line-- options only allow one http and one https listener. This data structure-- is used during option parsingdataMonadSnapm=>OptionDatama=OptionData{config::Configma,bind::MaybeByteString,port::MaybeInt,sslbind::MaybeByteString,sslport::MaybeInt,sslcert::MaybeFilePath,sslkey::MaybeFilePath,tout::MaybeInt}------------------------------------------------------------------------------instanceMonadSnapm=>Monoid(OptionDatama)wheremempty=OptionData{config=mempty,bind=Nothing,port=Nothing,sslbind=Nothing,sslport=Nothing,sslcert=Nothing,sslkey=Nothing,tout=Nothing}a`mappend`b=OptionData{config=(configb)`mappend`(configa),bind=(bindb)`mplus`(binda),port=(portb)`mplus`(porta),sslbind=(sslbindb)`mplus`(sslbinda),sslport=(sslportb)`mplus`(sslporta),sslcert=(sslcertb)`mplus`(sslcerta),sslkey=(sslkeyb)`mplus`(sslkeya),tout=(toutb)`mplus`(touta)}-------------------------------------------------------------------------------- | These are the default values for the optionsdefaultOptions::MonadSnapm=>OptionDatamadefaultOptions=OptionData{config=defaultConfig,bind=Just"0.0.0.0",port=Just8000,sslbind=Just"0.0.0.0",sslport=Nothing,sslcert=Just"cert.pem",sslkey=Just"key.pem",tout=Just60}-------------------------------------------------------------------------------- | Convert options to configoptionsToConfig::MonadSnapm=>OptionDatama->ConfigmaoptionsToConfigo=mconcat$[configo]++http++https++[tmOut]wherelhttp=maybe2[]ListenHttp(bindo)(porto)lhttps=maybe4[]ListenHttps(sslbindo)(sslporto)(sslcerto)(sslkeyo)http=map(flipaddListenmempty)lhttphttps=map(flipaddListenmempty)lhttpsmaybe2_f(Justa)(Justb)=[fab]maybe2d___=dmaybe4_f(Justa)(Justb)(Justc)(Justd)=[fabcd]maybe4d_____=dtmOut=maybemempty(\t->mempty{defaultTimeout=Justt})(touto)-------------------------------------------------------------------------------- | Convert config to optionsconfigToOptions::MonadSnapm=>Configma->OptionDatamaconfigToOptionsc=OptionData{config=c,bind=Nothing,port=Nothing,sslbind=Nothing,sslport=Nothing,sslcert=Nothing,sslkey=Nothing,tout=(defaultTimeoutc)}-------------------------------------------------------------------------------- | A description of the command-line options accepted by-- 'commandLineConfig'.---- The 'OptionData' parameter is just for specifying any default values which-- are to override those in 'defaultOptions'. This is so the usage message can-- accurately inform the user what the default values for the options are. In-- most cases, you will probably just end up passing 'mempty' for this-- parameter.---- The return type is a list of options describing @'Maybe' ('OptionData' m)@-- as opposed to @'OptionData' m@, because if the @--help@ option is given,-- the set of command-line options no longer describe a config, but an action-- (printing out the usage message).options::MonadSnapm=>OptionDatama->[OptDescr(Maybe(OptionDatama))]optionsdefaults=[Option[]["hostname"](ReqArg(Just.setConfigsetHostname.U.fromString)"NAME")$"local hostname"++defaultCgetHostname,Option['b']["address"](ReqArg(\s->Just$mempty{bind=Just$U.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$U.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=Just$reads})"PATH")$"path to ssl certificate in PEM format"++defaultOsslcert,Option[]["ssl-key"](ReqArg(\s->Just$mempty{sslkey=Just$reads})"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{tout=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=configToOptions$fcmemptyconf=completeConfig$configdefaultsopts=mappenddefaultOptionsdefaultsdefaultCf=maybe""((", default "++).show)$fconfdefaultOf=maybe", default off"((", default "++).show)$fopts-------------------------------------------------------------------------------- | This returns a 'Config' gotten from parsing the options specified on the-- command-line.---- The 'Config' parameter is just for specifying any default values which are-- to override those in 'defaultConfig'. This is so the usage message can-- accurately inform the user what the default values for the options are. In-- most cases, you will probably just end up passing 'mempty' for this-- parameter.---- On Unix systems, the locale is read from the @LANG@ environment variable.commandLineConfig::MonadSnapm=>Configma->IO(Configma)commandLineConfigdefaults=doargs<-getArgsprog<-getProgNameresult<-either(usageprog)return$casegetOptPermuteoptsargsof(f,_,[])->maybe(Left[])Right$fmapmconcat$sequencef(_,_,errs)->Lefterrsletresult'=optionsToConfig$mappenddefaultOptionsresult#ifndef PORTABLElang<-getEnv"LANG"return$mconcat[defaults,result',mempty{locale=fmapupToUtf8lang}]#elsereturn$mconcat[defaults,result']#endifwhereopts=options$configToOptionsdefaultsusageprogerrs=dolethdr="Usage:\n "++prog++" [OPTION...]\n\nOptions:"letmsg=concaterrs++usageInfohdroptshPutStrLnstderrmsgexitFailureupToUtf8=takeWhile$\c->isAlphac||'_'==c------------------------------------------------------------------------------getHostname::MonadSnapm=>Configma->MaybeByteStringgetHostname=hostname------------------------------------------------------------------------------getListen::MonadSnapm=>Configma->[ConfigListen]getListen=listen------------------------------------------------------------------------------getAccessLog::MonadSnapm=>Configma->Maybe(MaybeFilePath)getAccessLog=accessLog------------------------------------------------------------------------------getErrorLog::MonadSnapm=>Configma->Maybe(MaybeFilePath)getErrorLog=errorLog------------------------------------------------------------------------------getLocale::MonadSnapm=>Configma->MaybeStringgetLocale=locale------------------------------------------------------------------------------getBackend::MonadSnapm=>Configma->MaybeConfigBackendgetBackend=backend------------------------------------------------------------------------------getCompression::MonadSnapm=>Configma->MaybeBoolgetCompression=compression------------------------------------------------------------------------------getVerbose::MonadSnapm=>Configma->MaybeBoolgetVerbose=verbose------------------------------------------------------------------------------getErrorHandler::MonadSnapm=>Configma->Maybe(SomeException->m())getErrorHandler=errorHandler------------------------------------------------------------------------------getOther::MonadSnapm=>Configma->MaybeagetOther=other------------------------------------------------------------------------------getDefaultTimeout::MonadSnapm=>Configma->MaybeIntgetDefaultTimeout=defaultTimeout------------------------------------------------------------------------------setHostname::MonadSnapm=>ByteString->Configma->ConfigmasetHostnameam=m{hostname=Justa}------------------------------------------------------------------------------addListen::MonadSnapm=>ConfigListen->Configma->ConfigmaaddListenam=m{listen=a:listenm}------------------------------------------------------------------------------setAccessLog::MonadSnapm=>MaybeFilePath->Configma->ConfigmasetAccessLogam=m{accessLog=Justa}------------------------------------------------------------------------------setErrorLog::MonadSnapm=>MaybeFilePath->Configma->ConfigmasetErrorLogam=m{errorLog=Justa}------------------------------------------------------------------------------setLocale::MonadSnapm=>String->Configma->ConfigmasetLocaleam=m{locale=Justa}------------------------------------------------------------------------------setBackend::MonadSnapm=>ConfigBackend->Configma->ConfigmasetBackendam=m{backend=Justa}------------------------------------------------------------------------------setCompression::MonadSnapm=>Bool->Configma->ConfigmasetCompressionam=m{compression=Justa}------------------------------------------------------------------------------setVerbose::MonadSnapm=>Bool->Configma->ConfigmasetVerboseam=m{verbose=Justa}------------------------------------------------------------------------------setErrorHandler::MonadSnapm=>(SomeException->m())->Configma->ConfigmasetErrorHandleram=m{errorHandler=Justa}------------------------------------------------------------------------------setOther::MonadSnapm=>a->Configma->ConfigmasetOtheram=m{other=Justa}------------------------------------------------------------------------------setDefaultTimeout::MonadSnapm=>Int->Configma->ConfigmasetDefaultTimeouttm=m{defaultTimeout=Justt}