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