{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
------------------------------------------------------------------------------
-- | This module exports the 'Config' datatype, which you can use to configure
-- the Snap HTTP server.
--
module Snap.Internal.Http.Server.Config
  -- NOTE: also edit Snap.Http.Server.Config if you change these
  ( 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

  -- * Private
  , 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)


------------------------------------------------------------------------------
-- | FIXME
--
-- Note: this type changed in snap-server 1.0.0.0.
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 type representing the configuration of a logging target
data ConfigLog = ConfigNoLog                        -- ^ no logging
               | ConfigFileLog FilePath             -- ^ log to text file
               | ConfigIoLog (ByteString -> IO ())  -- ^ log custom IO handler

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"


------------------------------------------------------------------------------
-- We should be using ServerConfig here. There needs to be a clearer
-- separation between:
--
--   * what the underlying code needs to configure itself
--
--   * what the command-line processing does.
--
-- The latter will provide "library" helper functions that operate on
-- ServerConfig/etc in order to allow users to configure their own environment.
--
--
-- Todo:
--
--  * need a function ::
--      CommandLineConfig -> IO [(ServerConfig hookState, AcceptFunc)]
--
--       this will prep for another function that will spawn all of the
--       accept loops with httpAcceptLoop.
--
--  * all backends provide "Some -> Foo -> Config -> IO AcceptFunc"
--
--  * add support for socket activation to command line, or delegate to
--    different library? It's linux-only anyways, need to ifdef. It would be
--    silly to depend on the socket-activation library for that one little
--    function.
--
--  * break config into multiple modules:
--
--     * everything that modifies the snap handler (compression, proxy
--       settings, error handler)
--
--     * everything that directly modifies server settings (hostname /
--       defaultTimeout / hooks / etc)
--
--     * everything that configures backends (port/bind/ssl*)
--
--     * everything that handles command line stuff
--
--     * utility stuff
--
-- Cruft that definitely must be removed:
--
--  * ConfigLog -- this becomes a binary option on the command-line side (no
--    logging or yes, to this file), but the ConfigIoLog gets zapped
--    altogether.

------------------------------------------------------------------------------
-- | A record type which represents partial configurations (for 'httpServe')
-- by wrapping all of its fields in a 'Maybe'. Values of this type are usually
-- constructed via its 'Monoid' instance by doing something like:
--
-- > setPort 1234 mempty
--
-- Any fields which are unspecified in the 'Config' passed to 'httpServe' (and
-- this is the norm) are filled in with default values from 'defaultConfig'.
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

------------------------------------------------------------------------------
-- | The 'Typeable1' instance is here so 'Config' values can be
-- dynamically loaded with Hint.
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
$ []


------------------------------------------------------------------------------
-- | Returns a completely empty 'Config'. Equivalent to 'mempty' from
-- 'Config''s 'Monoid' instance.
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


------------------------------------------------------------------------------
-- | These are the default values for the options
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
    }


------------------------------------------------------------------------------
-- | The hostname of the HTTP server. This field has the same format as an HTTP
-- @Host@ header; if a @Host@ header came in with the request, we use that,
-- otherwise we default to this value specified in the configuration.
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

-- | Path to the access log
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

-- | Path to the error log
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

-- | Gets the locale to use. Locales are used on Unix only, to set the
-- @LANG@\/@LC_ALL@\/etc. environment variable. For instance if you set the
-- locale to \"@en_US@\", we'll set the relevant environment variables to
-- \"@en_US.UTF-8@\".
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

-- | Returns the port to listen on (for http)
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

-- | Returns the address to bind to (for http)
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

-- | Returns the port to listen on (for https)
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

-- | Returns the address to bind to (for https)
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

-- | Path to the SSL certificate file
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

-- | Path to the SSL certificate file
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

-- | Path to the SSL key file
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

-- | File path to unix socket. Must be absolute path, but allows for symbolic
-- links.
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

-- | Access mode for unix socket, by default is system specific.
-- This should only be used to grant additional permissions to created
-- socket file, and not to remove permissions set by default.
-- The only portable way to limit access to socket is creating it in a
-- directory with proper permissions set.
--
-- Most BSD systems ignore access permissions on unix sockets.
--
-- Note: This uses umask. There is a race condition if process creates other
-- files at the same time as opening a unix socket with this option set.
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

-- | If set and set to True, compression is turned on when applicable
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

-- | Whether to write server status updates to stderr
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

-- | A MonadSnap action to handle 500 errors
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

-- | A startup hook is run after the server initializes but before user request
-- processing begins. The server passes, through a 'StartupInfo' object, the
-- startup hook a list of the sockets it is listening on and the final 'Config'
-- object completed after command-line processing.
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 }


------------------------------------------------------------------------------

-- | Arguments passed to 'setStartupHook'.
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 []

-- | The 'Socket's opened by the server. There will be two 'Socket's for SSL
-- connections, and one otherwise.
getStartupSockets :: StartupInfo m a -> [Socket]
getStartupSockets :: forall (m :: * -> *) a. StartupInfo m a -> [Socket]
getStartupSockets = forall (m :: * -> *) a. StartupInfo m a -> [Socket]
startupHookSockets

-- The 'Config', after any command line parsing has been performed.
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


------------------------------------------------------------------------------
-- | Returns a description of the snap command line options suitable for use
-- with "System.Console.GetOpt".
optDescrs :: forall m a . MonadSnap m =>
             Config m a         -- ^ the configuration defaults.
          -> [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
           ]


------------------------------------------------------------------------------
-- | Returns a 'Config' obtained from parsing command-line options, using the
-- default Snap 'OptDescr' set.
--
-- On Unix systems, the locale is read from the @LANG@ environment variable.
commandLineConfig :: MonadSnap m
                  => Config m a
                      -- ^ default configuration. This is combined with
                      -- 'defaultConfig' to obtain default values to use if the
                      -- given parameter is specified on the command line.
                      -- Usually it is fine to use 'emptyConfig' here.
                  -> 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
    -- Here getOpt can ever change the "other" field, because we only use the
    -- Snap OptDescr list. The combining function will never be invoked.
    f :: a
f = forall a. HasCallStack => a
undefined


------------------------------------------------------------------------------
-- | Returns a 'Config' obtained from parsing command-line options, using the
-- default Snap 'OptDescr' set as well as a list of user OptDescrs. User
-- OptDescrs use the \"other\" field (accessible using 'getOther' and
-- 'setOther') to store additional command-line option state. These are
-- combined using a user-defined combining function.
--
-- On Unix systems, the locale is read from the @LANG@ environment variable.

extendedCommandLineConfig :: MonadSnap m
                          => [OptDescr (Maybe (Config m a))]
                             -- ^ Full list of command line options (combine
                             -- yours with 'optDescrs' to extend Snap's default
                             -- set of options)
                          -> (a -> a -> a)
                             -- ^ State for multiple invoked user command-line
                             -- options will be combined using this function.
                          -> Config m a
                             -- ^ default configuration. This is combined with
                             -- Snap's 'defaultConfig' to obtain default values
                             -- to use if the given parameter is specified on
                             -- the command line. Usually it is fine to use
                             -- 'emptyConfig' here.
                          -> 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 is only a Just if both a and b have other fields, and then
        -- we use the combining function. Config's mappend picks the last
        -- "Just" in the other list.
        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