{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Snap.Internal.Http.Server.Config
( ConfigLog(..)
, Config(..)
, ProxyType(..)
, emptyConfig
, defaultConfig
, commandLineConfig
, extendedCommandLineConfig
, completeConfig
, optDescrs
, fmapOpt
, getAccessLog
, getBind
, getCompression
, getDefaultTimeout
, getErrorHandler
, getErrorLog
, getHostname
, getLocale
, getOther
, getPort
, getProxyType
, getSSLBind
, getSSLCert
, getSSLChainCert
, getSSLKey
, getSSLPort
, getVerbose
, getStartupHook
, getUnixSocket
, getUnixSocketAccessMode
, setAccessLog
, setBind
, setCompression
, setDefaultTimeout
, setErrorHandler
, setErrorLog
, setHostname
, setLocale
, setOther
, setPort
, setProxyType
, setSSLBind
, setSSLCert
, setSSLChainCert
, setSSLKey
, setSSLPort
, setVerbose
, setUnixSocket
, setUnixSocketAccessMode
, setStartupHook
, StartupInfo(..)
, getStartupSockets
, getStartupConfig
, emptyStartupInfo
, setStartupSockets
, setStartupConfig
) where
import Control.Exception (SomeException)
import Control.Monad (when)
import Data.Bits ((.&.))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.CaseInsensitive as CI
import Data.Function (on)
import Data.List (foldl')
import qualified Data.Map as Map
import Data.Maybe (isJust, isNothing)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid (..))
#endif
import Data.Monoid (Last (Last, getLast))
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
#if MIN_VERSION_base(4,7,0)
import Data.Typeable (Typeable)
#else
import Data.Typeable (TyCon, Typeable, Typeable1 (..), mkTyCon3, mkTyConApp)
#endif
import Network.Socket (Socket)
import Numeric (readOct, showOct)
#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif
import System.Console.GetOpt (ArgDescr (..), ArgOrder (Permute), OptDescr (..), getOpt, usageInfo)
import System.Environment hiding (getEnv)
#ifndef PORTABLE
import Data.Char (isAlpha)
import System.Posix.Env (getEnv)
#endif
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import Data.ByteString.Builder (Builder, byteString, stringUtf8, toLazyByteString)
import qualified System.IO.Streams as Streams
import Snap.Core (MonadSnap, Request (rqClientAddr, rqClientPort, rqParams, rqPostParams), emptyResponse, finishWith, getsRequest, logError, setContentLength, setContentType, setResponseBody, setResponseStatus)
import Snap.Internal.Debug (debug)
data ProxyType = NoProxy
| HaProxy
| X_Forwarded_For
deriving (Int -> ProxyType -> ShowS
[ProxyType] -> ShowS
ProxyType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyType] -> ShowS
$cshowList :: [ProxyType] -> ShowS
show :: ProxyType -> String
$cshow :: ProxyType -> String
showsPrec :: Int -> ProxyType -> ShowS
$cshowsPrec :: Int -> ProxyType -> ShowS
Show, ProxyType -> ProxyType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyType -> ProxyType -> Bool
$c/= :: ProxyType -> ProxyType -> Bool
== :: ProxyType -> ProxyType -> Bool
$c== :: ProxyType -> ProxyType -> Bool
Eq, Typeable)
data ConfigLog = ConfigNoLog
| ConfigFileLog FilePath
| ConfigIoLog (ByteString -> IO ())
instance Show ConfigLog where
show :: ConfigLog -> String
show ConfigLog
ConfigNoLog = String
"no log"
show (ConfigFileLog String
f) = String
"log to file " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
f
show (ConfigIoLog ByteString -> IO ()
_) = String
"custom logging handler"
data Config m a = Config
{ forall (m :: * -> *) a. Config m a -> Maybe ByteString
hostname :: Maybe ByteString
, forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
accessLog :: Maybe ConfigLog
, forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
errorLog :: Maybe ConfigLog
, forall (m :: * -> *) a. Config m a -> Maybe String
locale :: Maybe String
, forall (m :: * -> *) a. Config m a -> Maybe Int
port :: Maybe Int
, forall (m :: * -> *) a. Config m a -> Maybe ByteString
bind :: Maybe ByteString
, forall (m :: * -> *) a. Config m a -> Maybe Int
sslport :: Maybe Int
, forall (m :: * -> *) a. Config m a -> Maybe ByteString
sslbind :: Maybe ByteString
, forall (m :: * -> *) a. Config m a -> Maybe String
sslcert :: Maybe FilePath
, forall (m :: * -> *) a. Config m a -> Maybe Bool
sslchaincert :: Maybe Bool
, forall (m :: * -> *) a. Config m a -> Maybe String
sslkey :: Maybe FilePath
, forall (m :: * -> *) a. Config m a -> Maybe String
unixsocket :: Maybe FilePath
, forall (m :: * -> *) a. Config m a -> Maybe Int
unixaccessmode :: Maybe Int
, forall (m :: * -> *) a. Config m a -> Maybe Bool
compression :: Maybe Bool
, forall (m :: * -> *) a. Config m a -> Maybe Bool
verbose :: Maybe Bool
, forall (m :: * -> *) a. Config m a -> Maybe (SomeException -> m ())
errorHandler :: Maybe (SomeException -> m ())
, forall (m :: * -> *) a. Config m a -> Maybe Int
defaultTimeout :: Maybe Int
, forall (m :: * -> *) a. Config m a -> Maybe a
other :: Maybe a
, forall (m :: * -> *) a. Config m a -> Maybe ProxyType
proxyType :: Maybe ProxyType
, forall (m :: * -> *) a.
Config m a -> Maybe (StartupInfo m a -> IO ())
startupHook :: Maybe (StartupInfo m a -> IO ())
}
#if MIN_VERSION_base(4,7,0)
deriving Typeable
#else
configTyCon :: TyCon
configTyCon = mkTyCon3 "snap-server" "Snap.Http.Server.Config" "Config"
{-# NOINLINE configTyCon #-}
instance (Typeable1 m) => Typeable1 (Config m) where
typeOf1 _ = mkTyConApp configTyCon [typeOf1 (undefined :: m ())]
#endif
instance Show (Config m a) where
show :: Config m a -> String
show Config m a
c = [String] -> String
unlines [ String
"Config:"
, String
"hostname: " forall a. [a] -> [a] -> [a]
++ String
_hostname
, String
"accessLog: " forall a. [a] -> [a] -> [a]
++ String
_accessLog
, String
"errorLog: " forall a. [a] -> [a] -> [a]
++ String
_errorLog
, String
"locale: " forall a. [a] -> [a] -> [a]
++ String
_locale
, String
"port: " forall a. [a] -> [a] -> [a]
++ String
_port
, String
"bind: " forall a. [a] -> [a] -> [a]
++ String
_bind
, String
"sslport: " forall a. [a] -> [a] -> [a]
++ String
_sslport
, String
"sslbind: " forall a. [a] -> [a] -> [a]
++ String
_sslbind
, String
"sslcert: " forall a. [a] -> [a] -> [a]
++ String
_sslcert
, String
"sslchaincert: " forall a. [a] -> [a] -> [a]
++ String
_sslchaincert
, String
"sslkey: " forall a. [a] -> [a] -> [a]
++ String
_sslkey
, String
"unixsocket: " forall a. [a] -> [a] -> [a]
++ String
_unixsocket
, String
"unixaccessmode: " forall a. [a] -> [a] -> [a]
++ String
_unixaccessmode
, String
"compression: " forall a. [a] -> [a] -> [a]
++ String
_compression
, String
"verbose: " forall a. [a] -> [a] -> [a]
++ String
_verbose
, String
"defaultTimeout: " forall a. [a] -> [a] -> [a]
++ String
_defaultTimeout
, String
"proxyType: " forall a. [a] -> [a] -> [a]
++ String
_proxyType
]
where
_hostname :: String
_hostname = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe ByteString
hostname Config m a
c
_accessLog :: String
_accessLog = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
accessLog Config m a
c
_errorLog :: String
_errorLog = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
errorLog Config m a
c
_locale :: String
_locale = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe String
locale Config m a
c
_port :: String
_port = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe Int
port Config m a
c
_bind :: String
_bind = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe ByteString
bind Config m a
c
_sslport :: String
_sslport = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe Int
sslport Config m a
c
_sslbind :: String
_sslbind = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe ByteString
sslbind Config m a
c
_sslcert :: String
_sslcert = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe String
sslcert Config m a
c
_sslchaincert :: String
_sslchaincert = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe Bool
sslchaincert Config m a
c
_sslkey :: String
_sslkey = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe String
sslkey Config m a
c
_compression :: String
_compression = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe Bool
compression Config m a
c
_verbose :: String
_verbose = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe Bool
verbose Config m a
c
_defaultTimeout :: String
_defaultTimeout = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe Int
defaultTimeout Config m a
c
_proxyType :: String
_proxyType = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe ProxyType
proxyType Config m a
c
_unixsocket :: String
_unixsocket = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe String
unixsocket Config m a
c
_unixaccessmode :: String
_unixaccessmode = case forall (m :: * -> *) a. Config m a -> Maybe Int
unixaccessmode Config m a
c of
Maybe Int
Nothing -> String
"Nothing"
Just Int
s -> (String
"Just 0" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showOct Int
s forall a b. (a -> b) -> a -> b
$ []
emptyConfig :: Config m a
emptyConfig :: forall (m :: * -> *) a. Config m a
emptyConfig = forall a. Monoid a => a
mempty
instance Semigroup (Config m a) where
Config m a
a <> :: Config m a -> Config m a -> Config m a
<> Config m a
b = Config
{ hostname :: Maybe ByteString
hostname = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe ByteString
hostname
, accessLog :: Maybe ConfigLog
accessLog = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
accessLog
, errorLog :: Maybe ConfigLog
errorLog = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
errorLog
, locale :: Maybe String
locale = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe String
locale
, port :: Maybe Int
port = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe Int
port
, bind :: Maybe ByteString
bind = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe ByteString
bind
, sslport :: Maybe Int
sslport = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe Int
sslport
, sslbind :: Maybe ByteString
sslbind = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe ByteString
sslbind
, sslcert :: Maybe String
sslcert = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe String
sslcert
, sslchaincert :: Maybe Bool
sslchaincert = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe Bool
sslchaincert
, sslkey :: Maybe String
sslkey = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe String
sslkey
, unixsocket :: Maybe String
unixsocket = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe String
unixsocket
, unixaccessmode :: Maybe Int
unixaccessmode = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe Int
unixaccessmode
, compression :: Maybe Bool
compression = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe Bool
compression
, verbose :: Maybe Bool
verbose = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe Bool
verbose
, errorHandler :: Maybe (SomeException -> m ())
errorHandler = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe (SomeException -> m ())
errorHandler
, defaultTimeout :: Maybe Int
defaultTimeout = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe Int
defaultTimeout
, other :: Maybe a
other = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe a
other
, proxyType :: Maybe ProxyType
proxyType = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a. Config m a -> Maybe ProxyType
proxyType
, startupHook :: Maybe (StartupInfo m a -> IO ())
startupHook = forall b. (Config m a -> Maybe b) -> Maybe b
ov forall (m :: * -> *) a.
Config m a -> Maybe (StartupInfo m a -> IO ())
startupHook
}
where
ov :: (Config m a -> Maybe b) -> Maybe b
ov :: forall b. (Config m a -> Maybe b) -> Maybe b
ov Config m a -> Maybe b
f = forall a. Last a -> Maybe a
getLast forall a b. (a -> b) -> a -> b
$! (forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a. Maybe a -> Last a
Last forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config m a -> Maybe b
f)) Config m a
a Config m a
b
instance Monoid (Config m a) where
mempty :: Config m a
mempty = Config
{ hostname :: Maybe ByteString
hostname = forall a. Maybe a
Nothing
, accessLog :: Maybe ConfigLog
accessLog = forall a. Maybe a
Nothing
, errorLog :: Maybe ConfigLog
errorLog = forall a. Maybe a
Nothing
, locale :: Maybe String
locale = forall a. Maybe a
Nothing
, port :: Maybe Int
port = forall a. Maybe a
Nothing
, bind :: Maybe ByteString
bind = forall a. Maybe a
Nothing
, sslport :: Maybe Int
sslport = forall a. Maybe a
Nothing
, sslbind :: Maybe ByteString
sslbind = forall a. Maybe a
Nothing
, sslcert :: Maybe String
sslcert = forall a. Maybe a
Nothing
, sslchaincert :: Maybe Bool
sslchaincert = forall a. Maybe a
Nothing
, sslkey :: Maybe String
sslkey = forall a. Maybe a
Nothing
, unixsocket :: Maybe String
unixsocket = forall a. Maybe a
Nothing
, unixaccessmode :: Maybe Int
unixaccessmode = forall a. Maybe a
Nothing
, compression :: Maybe Bool
compression = forall a. Maybe a
Nothing
, verbose :: Maybe Bool
verbose = forall a. Maybe a
Nothing
, errorHandler :: Maybe (SomeException -> m ())
errorHandler = forall a. Maybe a
Nothing
, defaultTimeout :: Maybe Int
defaultTimeout = forall a. Maybe a
Nothing
, other :: Maybe a
other = forall a. Maybe a
Nothing
, proxyType :: Maybe ProxyType
proxyType = forall a. Maybe a
Nothing
, startupHook :: Maybe (StartupInfo m a -> IO ())
startupHook = forall a. Maybe a
Nothing
}
#if !MIN_VERSION_base(4,11,0)
mappend = (<>)
#endif
defaultConfig :: MonadSnap m => Config m a
defaultConfig :: forall (m :: * -> *) a. MonadSnap m => Config m a
defaultConfig = forall a. Monoid a => a
mempty
{ hostname :: Maybe ByteString
hostname = forall a. a -> Maybe a
Just ByteString
"localhost"
, accessLog :: Maybe ConfigLog
accessLog = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ConfigLog
ConfigFileLog String
"log/access.log"
, errorLog :: Maybe ConfigLog
errorLog = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ConfigLog
ConfigFileLog String
"log/error.log"
, locale :: Maybe String
locale = forall a. a -> Maybe a
Just String
"en_US"
, compression :: Maybe Bool
compression = forall a. a -> Maybe a
Just Bool
True
, verbose :: Maybe Bool
verbose = forall a. a -> Maybe a
Just Bool
True
, errorHandler :: Maybe (SomeException -> m ())
errorHandler = forall a. a -> Maybe a
Just forall (m :: * -> *). MonadSnap m => SomeException -> m ()
defaultErrorHandler
, bind :: Maybe ByteString
bind = forall a. a -> Maybe a
Just ByteString
"0.0.0.0"
, sslbind :: Maybe ByteString
sslbind = forall a. Maybe a
Nothing
, sslcert :: Maybe String
sslcert = forall a. Maybe a
Nothing
, sslkey :: Maybe String
sslkey = forall a. Maybe a
Nothing
, sslchaincert :: Maybe Bool
sslchaincert = forall a. Maybe a
Nothing
, defaultTimeout :: Maybe Int
defaultTimeout = forall a. a -> Maybe a
Just Int
60
}
getHostname :: Config m a -> Maybe ByteString
getHostname :: forall (m :: * -> *) a. Config m a -> Maybe ByteString
getHostname = forall (m :: * -> *) a. Config m a -> Maybe ByteString
hostname
getAccessLog :: Config m a -> Maybe ConfigLog
getAccessLog :: forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
getAccessLog = forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
accessLog
getErrorLog :: Config m a -> Maybe ConfigLog
getErrorLog :: forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
getErrorLog = forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
errorLog
getLocale :: Config m a -> Maybe String
getLocale :: forall (m :: * -> *) a. Config m a -> Maybe String
getLocale = forall (m :: * -> *) a. Config m a -> Maybe String
locale
getPort :: Config m a -> Maybe Int
getPort :: forall (m :: * -> *) a. Config m a -> Maybe Int
getPort = forall (m :: * -> *) a. Config m a -> Maybe Int
port
getBind :: Config m a -> Maybe ByteString
getBind :: forall (m :: * -> *) a. Config m a -> Maybe ByteString
getBind = forall (m :: * -> *) a. Config m a -> Maybe ByteString
bind
getSSLPort :: Config m a -> Maybe Int
getSSLPort :: forall (m :: * -> *) a. Config m a -> Maybe Int
getSSLPort = forall (m :: * -> *) a. Config m a -> Maybe Int
sslport
getSSLBind :: Config m a -> Maybe ByteString
getSSLBind :: forall (m :: * -> *) a. Config m a -> Maybe ByteString
getSSLBind = forall (m :: * -> *) a. Config m a -> Maybe ByteString
sslbind
getSSLCert :: Config m a -> Maybe FilePath
getSSLCert :: forall (m :: * -> *) a. Config m a -> Maybe String
getSSLCert = forall (m :: * -> *) a. Config m a -> Maybe String
sslcert
getSSLChainCert :: Config m a -> Maybe Bool
getSSLChainCert :: forall (m :: * -> *) a. Config m a -> Maybe Bool
getSSLChainCert = forall (m :: * -> *) a. Config m a -> Maybe Bool
sslchaincert
getSSLKey :: Config m a -> Maybe FilePath
getSSLKey :: forall (m :: * -> *) a. Config m a -> Maybe String
getSSLKey = forall (m :: * -> *) a. Config m a -> Maybe String
sslkey
getUnixSocket :: Config m a -> Maybe FilePath
getUnixSocket :: forall (m :: * -> *) a. Config m a -> Maybe String
getUnixSocket = forall (m :: * -> *) a. Config m a -> Maybe String
unixsocket
getUnixSocketAccessMode :: Config m a -> Maybe Int
getUnixSocketAccessMode :: forall (m :: * -> *) a. Config m a -> Maybe Int
getUnixSocketAccessMode = forall (m :: * -> *) a. Config m a -> Maybe Int
unixaccessmode
getCompression :: Config m a -> Maybe Bool
getCompression :: forall (m :: * -> *) a. Config m a -> Maybe Bool
getCompression = forall (m :: * -> *) a. Config m a -> Maybe Bool
compression
getVerbose :: Config m a -> Maybe Bool
getVerbose :: forall (m :: * -> *) a. Config m a -> Maybe Bool
getVerbose = forall (m :: * -> *) a. Config m a -> Maybe Bool
verbose
getErrorHandler :: Config m a -> Maybe (SomeException -> m ())
getErrorHandler :: forall (m :: * -> *) a. Config m a -> Maybe (SomeException -> m ())
getErrorHandler = forall (m :: * -> *) a. Config m a -> Maybe (SomeException -> m ())
errorHandler
getDefaultTimeout :: Config m a -> Maybe Int
getDefaultTimeout :: forall (m :: * -> *) a. Config m a -> Maybe Int
getDefaultTimeout = forall (m :: * -> *) a. Config m a -> Maybe Int
defaultTimeout
getOther :: Config m a -> Maybe a
getOther :: forall (m :: * -> *) a. Config m a -> Maybe a
getOther = forall (m :: * -> *) a. Config m a -> Maybe a
other
getProxyType :: Config m a -> Maybe ProxyType
getProxyType :: forall (m :: * -> *) a. Config m a -> Maybe ProxyType
getProxyType = forall (m :: * -> *) a. Config m a -> Maybe ProxyType
proxyType
getStartupHook :: Config m a -> Maybe (StartupInfo m a -> IO ())
getStartupHook :: forall (m :: * -> *) a.
Config m a -> Maybe (StartupInfo m a -> IO ())
getStartupHook = forall (m :: * -> *) a.
Config m a -> Maybe (StartupInfo m a -> IO ())
startupHook
setHostname :: ByteString -> Config m a -> Config m a
setHostname :: forall (m :: * -> *) a. ByteString -> Config m a -> Config m a
setHostname ByteString
x Config m a
c = Config m a
c { hostname :: Maybe ByteString
hostname = forall a. a -> Maybe a
Just ByteString
x }
setAccessLog :: ConfigLog -> Config m a -> Config m a
setAccessLog :: forall (m :: * -> *) a. ConfigLog -> Config m a -> Config m a
setAccessLog ConfigLog
x Config m a
c = Config m a
c { accessLog :: Maybe ConfigLog
accessLog = forall a. a -> Maybe a
Just ConfigLog
x }
setErrorLog :: ConfigLog -> Config m a -> Config m a
setErrorLog :: forall (m :: * -> *) a. ConfigLog -> Config m a -> Config m a
setErrorLog ConfigLog
x Config m a
c = Config m a
c { errorLog :: Maybe ConfigLog
errorLog = forall a. a -> Maybe a
Just ConfigLog
x }
setLocale :: String -> Config m a -> Config m a
setLocale :: forall (m :: * -> *) a. String -> Config m a -> Config m a
setLocale String
x Config m a
c = Config m a
c { locale :: Maybe String
locale = forall a. a -> Maybe a
Just String
x }
setPort :: Int -> Config m a -> Config m a
setPort :: forall (m :: * -> *) a. Int -> Config m a -> Config m a
setPort Int
x Config m a
c = Config m a
c { port :: Maybe Int
port = forall a. a -> Maybe a
Just Int
x }
setBind :: ByteString -> Config m a -> Config m a
setBind :: forall (m :: * -> *) a. ByteString -> Config m a -> Config m a
setBind ByteString
x Config m a
c = Config m a
c { bind :: Maybe ByteString
bind = forall a. a -> Maybe a
Just ByteString
x }
setSSLPort :: Int -> Config m a -> Config m a
setSSLPort :: forall (m :: * -> *) a. Int -> Config m a -> Config m a
setSSLPort Int
x Config m a
c = Config m a
c { sslport :: Maybe Int
sslport = forall a. a -> Maybe a
Just Int
x }
setSSLBind :: ByteString -> Config m a -> Config m a
setSSLBind :: forall (m :: * -> *) a. ByteString -> Config m a -> Config m a
setSSLBind ByteString
x Config m a
c = Config m a
c { sslbind :: Maybe ByteString
sslbind = forall a. a -> Maybe a
Just ByteString
x }
setSSLCert :: FilePath -> Config m a -> Config m a
setSSLCert :: forall (m :: * -> *) a. String -> Config m a -> Config m a
setSSLCert String
x Config m a
c = Config m a
c { sslcert :: Maybe String
sslcert = forall a. a -> Maybe a
Just String
x }
setSSLChainCert :: Bool -> Config m a -> Config m a
setSSLChainCert :: forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setSSLChainCert Bool
x Config m a
c = Config m a
c { sslchaincert :: Maybe Bool
sslchaincert = forall a. a -> Maybe a
Just Bool
x }
setSSLKey :: FilePath -> Config m a -> Config m a
setSSLKey :: forall (m :: * -> *) a. String -> Config m a -> Config m a
setSSLKey String
x Config m a
c = Config m a
c { sslkey :: Maybe String
sslkey = forall a. a -> Maybe a
Just String
x }
setUnixSocket :: FilePath -> Config m a -> Config m a
setUnixSocket :: forall (m :: * -> *) a. String -> Config m a -> Config m a
setUnixSocket String
x Config m a
c = Config m a
c { unixsocket :: Maybe String
unixsocket = forall a. a -> Maybe a
Just String
x }
setUnixSocketAccessMode :: Int -> Config m a -> Config m a
setUnixSocketAccessMode :: forall (m :: * -> *) a. Int -> Config m a -> Config m a
setUnixSocketAccessMode Int
p Config m a
c = Config m a
c { unixaccessmode :: Maybe Int
unixaccessmode = forall a. a -> Maybe a
Just ( Int
p forall a. Bits a => a -> a -> a
.&. Int
0o777) }
setCompression :: Bool -> Config m a -> Config m a
setCompression :: forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setCompression Bool
x Config m a
c = Config m a
c { compression :: Maybe Bool
compression = forall a. a -> Maybe a
Just Bool
x }
setVerbose :: Bool -> Config m a -> Config m a
setVerbose :: forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setVerbose Bool
x Config m a
c = Config m a
c { verbose :: Maybe Bool
verbose = forall a. a -> Maybe a
Just Bool
x }
setErrorHandler :: (SomeException -> m ()) -> Config m a -> Config m a
setErrorHandler :: forall (m :: * -> *) a.
(SomeException -> m ()) -> Config m a -> Config m a
setErrorHandler SomeException -> m ()
x Config m a
c = Config m a
c { errorHandler :: Maybe (SomeException -> m ())
errorHandler = forall a. a -> Maybe a
Just SomeException -> m ()
x }
setDefaultTimeout :: Int -> Config m a -> Config m a
setDefaultTimeout :: forall (m :: * -> *) a. Int -> Config m a -> Config m a
setDefaultTimeout Int
x Config m a
c = Config m a
c { defaultTimeout :: Maybe Int
defaultTimeout = forall a. a -> Maybe a
Just Int
x }
setOther :: a -> Config m a -> Config m a
setOther :: forall a (m :: * -> *). a -> Config m a -> Config m a
setOther a
x Config m a
c = Config m a
c { other :: Maybe a
other = forall a. a -> Maybe a
Just a
x }
setProxyType :: ProxyType -> Config m a -> Config m a
setProxyType :: forall (m :: * -> *) a. ProxyType -> Config m a -> Config m a
setProxyType ProxyType
x Config m a
c = Config m a
c { proxyType :: Maybe ProxyType
proxyType = forall a. a -> Maybe a
Just ProxyType
x }
setStartupHook :: (StartupInfo m a -> IO ()) -> Config m a -> Config m a
setStartupHook :: forall (m :: * -> *) a.
(StartupInfo m a -> IO ()) -> Config m a -> Config m a
setStartupHook StartupInfo m a -> IO ()
x Config m a
c = Config m a
c { startupHook :: Maybe (StartupInfo m a -> IO ())
startupHook = forall a. a -> Maybe a
Just StartupInfo m a -> IO ()
x }
data StartupInfo m a = StartupInfo
{ forall (m :: * -> *) a. StartupInfo m a -> Config m a
startupHookConfig :: Config m a
, forall (m :: * -> *) a. StartupInfo m a -> [Socket]
startupHookSockets :: [Socket]
}
emptyStartupInfo :: StartupInfo m a
emptyStartupInfo :: forall (m :: * -> *) a. StartupInfo m a
emptyStartupInfo = forall (m :: * -> *) a. Config m a -> [Socket] -> StartupInfo m a
StartupInfo forall (m :: * -> *) a. Config m a
emptyConfig []
getStartupSockets :: StartupInfo m a -> [Socket]
getStartupSockets :: forall (m :: * -> *) a. StartupInfo m a -> [Socket]
getStartupSockets = forall (m :: * -> *) a. StartupInfo m a -> [Socket]
startupHookSockets
getStartupConfig :: StartupInfo m a -> Config m a
getStartupConfig :: forall (m :: * -> *) a. StartupInfo m a -> Config m a
getStartupConfig = forall (m :: * -> *) a. StartupInfo m a -> Config m a
startupHookConfig
setStartupSockets :: [Socket] -> StartupInfo m a -> StartupInfo m a
setStartupSockets :: forall (m :: * -> *) a.
[Socket] -> StartupInfo m a -> StartupInfo m a
setStartupSockets [Socket]
x StartupInfo m a
c = StartupInfo m a
c { startupHookSockets :: [Socket]
startupHookSockets = [Socket]
x }
setStartupConfig :: Config m a -> StartupInfo m a -> StartupInfo m a
setStartupConfig :: forall (m :: * -> *) a.
Config m a -> StartupInfo m a -> StartupInfo m a
setStartupConfig Config m a
x StartupInfo m a
c = StartupInfo m a
c { startupHookConfig :: Config m a
startupHookConfig = Config m a
x }
completeConfig :: (MonadSnap m) => Config m a -> IO (Config m a)
completeConfig :: forall (m :: * -> *) a.
MonadSnap m =>
Config m a -> IO (Config m a)
completeConfig Config m a
config = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
noPort forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr
String
"no port specified, defaulting to port 8000"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Config m a
cfg forall a. Monoid a => a -> a -> a
`mappend` forall (m :: * -> *) a. Config m a
cfg'
where
cfg :: Config m a
cfg = forall (m :: * -> *) a. MonadSnap m => Config m a
defaultConfig forall a. Monoid a => a -> a -> a
`mappend` Config m a
config
sslVals :: [Bool]
sslVals = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ Config m a
cfg) [ forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Config m a -> Maybe Int
getSSLPort
, forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Config m a -> Maybe ByteString
getSSLBind
, forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Config m a -> Maybe String
getSSLKey
, forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Config m a -> Maybe String
getSSLCert ]
sslValid :: Bool
sslValid = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
sslVals
unixValid :: Bool
unixValid = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Config m a -> Maybe String
unixsocket Config m a
cfg
noPort :: Bool
noPort = forall a. Maybe a -> Bool
isNothing (forall (m :: * -> *) a. Config m a -> Maybe Int
getPort Config m a
cfg) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sslValid Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
unixValid
cfg' :: Config m a
cfg' = forall (m :: * -> *) a. Config m a
emptyConfig { port :: Maybe Int
port = if Bool
noPort then forall a. a -> Maybe a
Just Int
8000 else forall a. Maybe a
Nothing }
bsFromString :: String -> ByteString
bsFromString :: String -> ByteString
bsFromString = Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
toString :: ByteString -> String
toString :: ByteString -> String
toString = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8
optDescrs :: forall m a . MonadSnap m =>
Config m a
-> [OptDescr (Maybe (Config m a))]
optDescrs :: forall (m :: * -> *) a.
MonadSnap m =>
Config m a -> [OptDescr (Maybe (Config m a))]
optDescrs Config m a
defaults =
[ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"hostname"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. ByteString -> Config m a -> Config m a
setHostname forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
bsFromString) String
"NAME")
forall a b. (a -> b) -> a -> b
$ String
"local hostname" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultC forall (m :: * -> *) a. Config m a -> Maybe ByteString
getHostname
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"b" [String
"address"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { bind :: Maybe ByteString
bind = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ByteString
bsFromString String
s })
String
"ADDRESS")
forall a b. (a -> b) -> a -> b
$ String
"address to bind to" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultO forall (m :: * -> *) a. Config m a -> Maybe ByteString
bind
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"port"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { port :: Maybe Int
port = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
s}) String
"PORT")
forall a b. (a -> b) -> a -> b
$ String
"port to listen on" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultO forall (m :: * -> *) a. Config m a -> Maybe Int
port
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"ssl-address"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslbind :: Maybe ByteString
sslbind = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ByteString
bsFromString String
s })
String
"ADDRESS")
forall a b. (a -> b) -> a -> b
$ String
"ssl address to bind to" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultO forall (m :: * -> *) a. Config m a -> Maybe ByteString
sslbind
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"ssl-port"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslport :: Maybe Int
sslport = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
s}) String
"PORT")
forall a b. (a -> b) -> a -> b
$ String
"ssl port to listen on" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultO forall (m :: * -> *) a. Config m a -> Maybe Int
sslport
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"ssl-cert"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslcert :: Maybe String
sslcert = forall a. a -> Maybe a
Just String
s}) String
"PATH")
forall a b. (a -> b) -> a -> b
$ String
"path to ssl certificate in PEM format" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultO forall (m :: * -> *) a. Config m a -> Maybe String
sslcert
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ssl-chain-cert"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setSSLChainCert Bool
True)
forall a b. (a -> b) -> a -> b
$ String
"certificate file contains complete certificate chain" forall a. [a] -> [a] -> [a]
++ (Config m a -> Maybe Bool) -> String -> ShowS
defaultB forall (m :: * -> *) a. Config m a -> Maybe Bool
sslchaincert String
"site certificate only" String
"complete certificate chain"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"no-ssl-chain-cert"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setSSLChainCert Bool
False)
forall a b. (a -> b) -> a -> b
$ String
"certificate file contains only the site certificate" forall a. [a] -> [a] -> [a]
++ (Config m a -> Maybe Bool) -> String -> ShowS
defaultB forall (m :: * -> *) a. Config m a -> Maybe Bool
sslchaincert String
"site certificate only" String
"complete certificate chain"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ssl-key"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { sslkey :: Maybe String
sslkey = forall a. a -> Maybe a
Just String
s}) String
"PATH")
forall a b. (a -> b) -> a -> b
$ String
"path to ssl private key in PEM format" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultO forall (m :: * -> *) a. Config m a -> Maybe String
sslkey
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"access-log"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. ConfigLog -> Config m a -> Config m a
setAccessLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ConfigLog
ConfigFileLog) String
"PATH")
forall a b. (a -> b) -> a -> b
$ String
"access log" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultC forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
getAccessLog
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"error-log"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. ConfigLog -> Config m a -> Config m a
setErrorLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ConfigLog
ConfigFileLog) String
"PATH")
forall a b. (a -> b) -> a -> b
$ String
"error log" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultC forall (m :: * -> *) a. Config m a -> Maybe ConfigLog
getErrorLog
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"no-access-log"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. ConfigLog -> Config m a -> Config m a
setAccessLog ConfigLog
ConfigNoLog)
String
"don't have an access log"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"no-error-log"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. ConfigLog -> Config m a -> Config m a
setErrorLog ConfigLog
ConfigNoLog)
String
"don't have an error log"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"c" [String
"compression"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setCompression Bool
True)
forall a b. (a -> b) -> a -> b
$ String
"use gzip compression on responses" forall a. [a] -> [a] -> [a]
++
(Config m a -> Maybe Bool) -> String -> ShowS
defaultB forall (m :: * -> *) a. Config m a -> Maybe Bool
getCompression String
"compressed" String
"uncompressed"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"t" [String
"timeout"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty {
defaultTimeout :: Maybe Int
defaultTimeout = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
t
}) String
"SECS")
forall a b. (a -> b) -> a -> b
$ String
"set default timeout in seconds" forall a. [a] -> [a] -> [a]
++ forall b. Show b => (Config m a -> Maybe b) -> String
defaultC forall (m :: * -> *) a. Config m a -> Maybe Int
defaultTimeout
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"no-compression"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setCompression Bool
False)
forall a b. (a -> b) -> a -> b
$ String
"serve responses uncompressed" forall a. [a] -> [a] -> [a]
++
(Config m a -> Maybe Bool) -> String -> ShowS
defaultB forall (m :: * -> *) a. Config m a -> Maybe Bool
compression String
"compressed" String
"uncompressed"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"verbose"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setVerbose Bool
True)
forall a b. (a -> b) -> a -> b
$ String
"print server status updates to stderr" forall a. [a] -> [a] -> [a]
++
forall b. Show b => (Config m a -> Maybe b) -> String
defaultC forall (m :: * -> *) a. Config m a -> Maybe Bool
getVerbose
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"q" [String
"quiet"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. Bool -> Config m a -> Config m a
setVerbose Bool
False)
forall a b. (a -> b) -> a -> b
$ String
"do not print anything to stderr" forall a. [a] -> [a] -> [a]
++
(Config m a -> Maybe Bool) -> String -> ShowS
defaultB forall (m :: * -> *) a. Config m a -> Maybe Bool
getVerbose String
"verbose" String
"quiet"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"proxy"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. ProxyType -> Config m a -> Config m a
setProxyType forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI String -> ProxyType
parseProxy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FoldCase s => s -> CI s
CI.mk)
String
"X_Forwarded_For")
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Set --proxy=X_Forwarded_For if your snap application \n"
, String
"is behind an HTTP reverse proxy to ensure that \n"
, String
"rqClientAddr is set properly.\n"
, String
"Set --proxy=haproxy to use the haproxy protocol\n("
, String
"http://haproxy.1wt.eu/download/1.5/doc/proxy-protocol.txt)"
, forall b. Show b => (Config m a -> Maybe b) -> String
defaultC forall (m :: * -> *) a. Config m a -> Maybe ProxyType
getProxyType ]
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"unix-socket"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. String -> Config m a -> Config m a
setUnixSocket) String
"PATH")
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Absolute path to unix socket file. "
, String
"File will be removed if already exists"]
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"unix-socket-mode"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {t} {t}. Monoid t => (t -> t -> t) -> t -> t
setConfig forall (m :: * -> *) a. Int -> Config m a -> Config m a
setUnixSocketAccessMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Num a, Ord a) => String -> a
parseOctal)
String
"MODE")
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Access mode for unix socket in octal, for example 0760.\n"
,String
" Default is system specific."]
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"h" [String
"help"]
(forall a. a -> ArgDescr a
NoArg forall a. Maybe a
Nothing)
String
"display this help and exit"
]
where
parseProxy :: CI String -> ProxyType
parseProxy CI String
s | CI String
s forall a. Eq a => a -> a -> Bool
== CI String
"NoProxy" = ProxyType
NoProxy
| CI String
s forall a. Eq a => a -> a -> Bool
== CI String
"X_Forwarded_For" = ProxyType
X_Forwarded_For
| CI String
s forall a. Eq a => a -> a -> Bool
== CI String
"haproxy" = ProxyType
HaProxy
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
String
"Error (--proxy): expected one of 'NoProxy', "
, String
"'X_Forwarded_For', or 'haproxy'. Got '"
, forall s. CI s -> s
CI.original CI String
s
, String
"'"
]
parseOctal :: String -> a
parseOctal String
s = case forall a. (Eq a, Num a) => ReadS a
readOct String
s of
((a
v, String
_):[(a, String)]
_) | a
v forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
v forall a. Ord a => a -> a -> Bool
<= a
0o777 -> a
v
[(a, String)]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Error (--unix-socket-mode): expected octal access mode"
setConfig :: (t -> t -> t) -> t -> t
setConfig t -> t -> t
f t
c = t -> t -> t
f t
c forall a. Monoid a => a
mempty
conf :: Config m a
conf = forall (m :: * -> *) a. MonadSnap m => Config m a
defaultConfig forall a. Monoid a => a -> a -> a
`mappend` Config m a
defaults
defaultB :: (Config m a -> Maybe Bool) -> String -> String -> String
defaultB :: (Config m a -> Maybe Bool) -> String -> ShowS
defaultB Config m a -> Maybe Bool
f String
y String
n = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Bool
b -> String
", default " forall a. [a] -> [a] -> [a]
++ if Bool
b
then String
y
else String
n) forall a b. (a -> b) -> a -> b
$ Config m a -> Maybe Bool
f Config m a
conf) :: String
defaultC :: (Show b) => (Config m a -> Maybe b) -> String
defaultC :: forall b. Show b => (Config m a -> Maybe b) -> String
defaultC Config m a -> Maybe b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
", default " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Config m a -> Maybe b
f Config m a
conf
defaultO :: (Show b) => (Config m a -> Maybe b) -> String
defaultO :: forall b. Show b => (Config m a -> Maybe b) -> String
defaultO Config m a -> Maybe b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
", default off" ((String
", default " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Config m a -> Maybe b
f Config m a
conf
defaultErrorHandler :: MonadSnap m => SomeException -> m ()
defaultErrorHandler :: forall (m :: * -> *). MonadSnap m => SomeException -> m ()
defaultErrorHandler SomeException
e = do
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"Snap.Http.Server.Config errorHandler:"
Request
req <- forall (m :: * -> *) a. MonadSnap m => (Request -> a) -> m a
getsRequest Request -> Request
blindParams
let sm :: ByteString
sm = Request -> ByteString
smsg Request
req
forall (m :: * -> *). MonadIO m => String -> m ()
debug forall a b. (a -> b) -> a -> b
$ ByteString -> String
toString ByteString
sm
forall (m :: * -> *). MonadSnap m => ByteString -> m ()
logError ByteString
sm
forall (m :: * -> *) a. MonadSnap m => Response -> m a
finishWith forall a b. (a -> b) -> a -> b
$ ByteString -> Response -> Response
setContentType ByteString
"text/plain; charset=utf-8"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Response -> Response
setContentLength (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> Response -> Response
setResponseStatus Int
500 ByteString
"Internal Server Error"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutputStream Builder -> IO (OutputStream Builder))
-> Response -> Response
setResponseBody OutputStream Builder -> IO (OutputStream Builder)
errBody
forall a b. (a -> b) -> a -> b
$ Response
emptyResponse
where
blindParams :: Request -> Request
blindParams Request
r = Request
r { rqPostParams :: Params
rqPostParams = forall {k} {a}. Map k a -> Map k [ByteString]
rmValues forall a b. (a -> b) -> a -> b
$ Request -> Params
rqPostParams Request
r
, rqParams :: Params
rqParams = forall {k} {a}. Map k a -> Map k [ByteString]
rmValues forall a b. (a -> b) -> a -> b
$ Request -> Params
rqParams Request
r }
rmValues :: Map k a -> Map k [ByteString]
rmValues = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a b. a -> b -> a
const [ByteString
"..."])
errBody :: OutputStream Builder -> IO (OutputStream Builder)
errBody OutputStream Builder
os = forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just Builder
msgB) OutputStream Builder
os forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return OutputStream Builder
os
toByteString :: Builder -> ByteString
toByteString = [ByteString] -> ByteString
S.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
smsg :: Request -> ByteString
smsg Request
req = Builder -> ByteString
toByteString forall a b. (a -> b) -> a -> b
$ Request -> SomeException -> Builder
requestErrorMessage Request
req SomeException
e
msg :: ByteString
msg = Builder -> ByteString
toByteString Builder
msgB
msgB :: Builder
msgB = forall a. Monoid a => [a] -> a
mconcat [
ByteString -> Builder
byteString ByteString
"A web handler threw an exception. Details:\n"
, String -> Builder
stringUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SomeException
e
]
commandLineConfig :: MonadSnap m
=> Config m a
-> IO (Config m a)
commandLineConfig :: forall (m :: * -> *) a.
MonadSnap m =>
Config m a -> IO (Config m a)
commandLineConfig Config m a
defaults = forall (m :: * -> *) a.
MonadSnap m =>
[OptDescr (Maybe (Config m a))]
-> (a -> a -> a) -> Config m a -> IO (Config m a)
extendedCommandLineConfig (forall (m :: * -> *) a.
MonadSnap m =>
Config m a -> [OptDescr (Maybe (Config m a))]
optDescrs Config m a
defaults) forall {a}. a
f Config m a
defaults
where
f :: a
f = forall a. HasCallStack => a
undefined
extendedCommandLineConfig :: MonadSnap m
=> [OptDescr (Maybe (Config m a))]
-> (a -> a -> a)
-> Config m a
-> IO (Config m a)
extendedCommandLineConfig :: forall (m :: * -> *) a.
MonadSnap m =>
[OptDescr (Maybe (Config m a))]
-> (a -> a -> a) -> Config m a -> IO (Config m a)
extendedCommandLineConfig [OptDescr (Maybe (Config m a))]
opts a -> a -> a
combiningFunction Config m a
defaults = do
[String]
args <- IO [String]
getArgs
String
prog <- IO String
getProgName
Config m a
result <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall {t :: * -> *} {b}. Foldable t => String -> t String -> IO b
usage String
prog)
forall (m :: * -> *) a. Monad m => a -> m a
return
(case forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt forall a. ArgOrder a
Permute [OptDescr (Maybe (Config m a))]
opts [String]
args of
([Maybe (Config m a)]
f, [String]
_, [] ) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left []) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {m :: * -> *}. Config m a -> Config m a -> Config m a
combine forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe (Config m a)]
f
([Maybe (Config m a)]
_, [String]
_, [String]
errs) -> forall a b. a -> Either a b
Left [String]
errs)
#ifndef PORTABLE
Maybe String
lang <- String -> IO (Maybe String)
getEnv String
"LANG"
forall (m :: * -> *) a.
MonadSnap m =>
Config m a -> IO (Config m a)
completeConfig forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Config m a
defaults,
forall a. Monoid a => a
mempty {locale :: Maybe String
locale = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
upToUtf8 Maybe String
lang},
Config m a
result]
#else
completeConfig $ mconcat [defaults, result]
#endif
where
usage :: String -> t String -> IO b
usage String
prog t String
errs = do
let hdr :: String
hdr = String
"Usage:\n " forall a. [a] -> [a] -> [a]
++ String
prog forall a. [a] -> [a] -> [a]
++ String
" [OPTION...]\n\nOptions:"
let msg :: String
msg = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t String
errs forall a. [a] -> [a] -> [a]
++ forall a. String -> [OptDescr a] -> String
usageInfo String
hdr [OptDescr (Maybe (Config m a))]
opts
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
forall a. IO a
exitFailure
#ifndef PORTABLE
upToUtf8 :: ShowS
upToUtf8 = forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
'_' forall a. Eq a => a -> a -> Bool
== Char
c
#endif
combine :: Config m a -> Config m a -> Config m a
combine !Config m a
a !Config m a
b = Config m a
a forall a. Monoid a => a -> a -> a
`mappend` Config m a
b forall a. Monoid a => a -> a -> a
`mappend` forall {m :: * -> *}. Config m a
newOther
where
combined :: Maybe a
combined = do
a
x <- forall (m :: * -> *) a. Config m a -> Maybe a
getOther Config m a
a
a
y <- forall (m :: * -> *) a. Config m a -> Maybe a
getOther Config m a
b
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> a -> a
combiningFunction a
x a
y
newOther :: Config m a
newOther = forall a. Monoid a => a
mempty { other :: Maybe a
other = Maybe a
combined }
fmapArg :: (a -> b) -> ArgDescr a -> ArgDescr b
fmapArg :: forall a b. (a -> b) -> ArgDescr a -> ArgDescr b
fmapArg a -> b
f (NoArg a
a) = forall a. a -> ArgDescr a
NoArg (a -> b
f a
a)
fmapArg a -> b
f (ReqArg String -> a
g String
s) = forall a. (String -> a) -> String -> ArgDescr a
ReqArg (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
g) String
s
fmapArg a -> b
f (OptArg Maybe String -> a
g String
s) = forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> a
g) String
s
fmapOpt :: (a -> b) -> OptDescr a -> OptDescr b
fmapOpt :: forall a b. (a -> b) -> OptDescr a -> OptDescr b
fmapOpt a -> b
f (Option String
s [String]
l ArgDescr a
d String
e) = forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
s [String]
l (forall a b. (a -> b) -> ArgDescr a -> ArgDescr b
fmapArg a -> b
f ArgDescr a
d) String
e
requestErrorMessage :: Request -> SomeException -> Builder
requestErrorMessage :: Request -> SomeException -> Builder
requestErrorMessage Request
req SomeException
e =
forall a. Monoid a => [a] -> a
mconcat [ ByteString -> Builder
byteString ByteString
"During processing of request from "
, ByteString -> Builder
byteString forall a b. (a -> b) -> a -> b
$ Request -> ByteString
rqClientAddr Request
req
, ByteString -> Builder
byteString ByteString
":"
, forall a. Show a => a -> Builder
fromShow forall a b. (a -> b) -> a -> b
$ Request -> Int
rqClientPort Request
req
, ByteString -> Builder
byteString ByteString
"\nrequest:\n"
, forall a. Show a => a -> Builder
fromShow forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Request
req
, ByteString -> Builder
byteString ByteString
"\n"
, Builder
msgB
]
where
msgB :: Builder
msgB = forall a. Monoid a => [a] -> a
mconcat [
ByteString -> Builder
byteString ByteString
"A web handler threw an exception. Details:\n"
, forall a. Show a => a -> Builder
fromShow SomeException
e
]
fromShow :: Show a => a -> Builder
fromShow :: forall a. Show a => a -> Builder
fromShow = String -> Builder
stringUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show