-- -----------------------------------------------------------------------------
-- Copyright 2002, Simon Marlow.
-- Copyright 2009, Henning Thielemann.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--  * Redistributions of source code must retain the above copyright notice,
--    this list of conditions and the following disclaimer.
--
--  * Redistributions in binary form must reproduce the above copyright
--    notice, this list of conditions and the following disclaimer in the
--    documentation and/or other materials provided with the distribution.
--
--  * Neither the name of the copyright holder(s) nor the names of
--    contributors may be used to endorse or promote products derived from
--    this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-- -----------------------------------------------------------------------------

module Network.MoHWS.Configuration where

import qualified Data.Set as Set
import qualified Network.MoHWS.Logger.Level as LogLevel
import qualified Data.Accessor.Basic as Accessor
import Network.Socket (PortNumber, )

import qualified Data.List as List
import qualified Data.Version as Ver
import qualified Paths_mohws as Global


-----------------------------------------------------------------------------
-- Config info

data T ext = Cons {
  T ext -> String
user                  :: String,
  T ext -> String
group                 :: String,

  T ext -> [(Maybe String, PortNumber)]
listen                :: [(Maybe String, PortNumber)],

  T ext -> Int
requestTimeout        :: Int,
  T ext -> Int
keepAliveTimeout      :: Int,
  T ext -> Int
maxClients            :: Int,

  T ext -> String
serverAdmin           :: String,      -- "" indicates no admin
  T ext -> String
serverName            :: String,      -- "" indicates no canon name
  T ext -> Set String
serverAlias           :: Set.Set String,
  T ext -> Bool
useCanonicalName      :: Bool,
  T ext -> Bool
hostnameLookups       :: Bool,

  T ext -> String
documentRoot          :: FilePath,
  T ext -> String
accessFileName        :: FilePath,
  T ext -> Bool
indexes               :: Bool,
  T ext -> Bool
followSymbolicLinks   :: Bool,
  T ext -> Int
chunkSize             :: Int,

  T ext -> String
typesConfig           :: String,
  T ext -> String
defaultType           :: String,

  T ext -> [(String, String)]
addLanguage           :: [(String,String)],
  T ext -> [String]
languagePriority      :: [String],

  T ext -> [(String, String)]
customLogs            :: [(FilePath, String)],

  T ext -> String
errorLogFile          :: FilePath,
  T ext -> T
logLevel              :: LogLevel.T,

  T ext -> ext
extension             :: ext
  }
  deriving Int -> T ext -> ShowS
[T ext] -> ShowS
T ext -> String
(Int -> T ext -> ShowS)
-> (T ext -> String) -> ([T ext] -> ShowS) -> Show (T ext)
forall ext. Show ext => Int -> T ext -> ShowS
forall ext. Show ext => [T ext] -> ShowS
forall ext. Show ext => T ext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T ext] -> ShowS
$cshowList :: forall ext. Show ext => [T ext] -> ShowS
show :: T ext -> String
$cshow :: forall ext. Show ext => T ext -> String
showsPrec :: Int -> T ext -> ShowS
$cshowsPrec :: forall ext. Show ext => Int -> T ext -> ShowS
Show

deflt :: ext -> T ext
deflt :: ext -> T ext
deflt ext
ext = Cons :: forall ext.
String
-> String
-> [(Maybe String, PortNumber)]
-> Int
-> Int
-> Int
-> String
-> String
-> Set String
-> Bool
-> Bool
-> String
-> String
-> Bool
-> Bool
-> Int
-> String
-> String
-> [(String, String)]
-> [String]
-> [(String, String)]
-> String
-> T
-> ext
-> T ext
Cons {
  user :: String
user = String
"nobody",
  group :: String
group = String
"nobody",

  listen :: [(Maybe String, PortNumber)]
listen                = [(Maybe String
forall a. Maybe a
Nothing,PortNumber
80)],

  requestTimeout :: Int
requestTimeout        = Int
300,
  keepAliveTimeout :: Int
keepAliveTimeout      = Int
15,
  maxClients :: Int
maxClients            = Int
150,

  serverAdmin :: String
serverAdmin           = String
"",
  serverName :: String
serverName            = String
"",
  serverAlias :: Set String
serverAlias           = Set String
forall a. Set a
Set.empty,
  useCanonicalName :: Bool
useCanonicalName      = Bool
False,
  hostnameLookups :: Bool
hostnameLookups       = Bool
False,

  documentRoot :: String
documentRoot          = String
".",
  accessFileName :: String
accessFileName        = String
".htaccess",
  indexes :: Bool
indexes               = Bool
False,
  followSymbolicLinks :: Bool
followSymbolicLinks   = Bool
False,
  chunkSize :: Int
chunkSize             = Int
4096,

  typesConfig :: String
typesConfig           = String
"/etc/mime.types",
  defaultType :: String
defaultType           = String
"text/plain",

  addLanguage :: [(String, String)]
addLanguage           = [],
  languagePriority :: [String]
languagePriority      = [],

  customLogs :: [(String, String)]
customLogs            = [(String
"http-access.log",
                            String
"%h %l %u %t \"%r\" %s %b \"%{Referer}i\" \"%{User-Agent}i\"")],

  errorLogFile :: String
errorLogFile          = String
"httpd-error.log",
  logLevel :: T
logLevel              = T
LogLevel.Warn,

  extension :: ext
extension             = ext
ext
  }

-- not user-definable...
serverSoftware, serverVersion :: String
serverSoftware :: String
serverSoftware = String
"MoHWS"
serverVersion :: String
serverVersion  =
   [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
List.intersperse String
"." ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String]) -> [Int] -> [String]
forall a b. (a -> b) -> a -> b
$
   Version -> [Int]
Ver.versionBranch Version
Global.version


extensionAcc :: Accessor.T (T ext) ext
extensionAcc :: T (T ext) ext
extensionAcc =
   (ext -> T ext -> T ext) -> (T ext -> ext) -> T (T ext) ext
forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\ext
e T ext
c -> T ext
c{extension :: ext
extension=ext
e}) T ext -> ext
forall ext. T ext -> ext
extension


instance Functor T where
   fmap :: (a -> b) -> T a -> T b
fmap a -> b
f T a
c = Cons :: forall ext.
String
-> String
-> [(Maybe String, PortNumber)]
-> Int
-> Int
-> Int
-> String
-> String
-> Set String
-> Bool
-> Bool
-> String
-> String
-> Bool
-> Bool
-> Int
-> String
-> String
-> [(String, String)]
-> [String]
-> [(String, String)]
-> String
-> T
-> ext
-> T ext
Cons {
      user :: String
user                  = T a -> String
forall ext. T ext -> String
user T a
c,
      group :: String
group                 = T a -> String
forall ext. T ext -> String
group T a
c,

      listen :: [(Maybe String, PortNumber)]
listen                = T a -> [(Maybe String, PortNumber)]
forall ext. T ext -> [(Maybe String, PortNumber)]
listen T a
c,

      requestTimeout :: Int
requestTimeout        = T a -> Int
forall ext. T ext -> Int
requestTimeout T a
c,
      keepAliveTimeout :: Int
keepAliveTimeout      = T a -> Int
forall ext. T ext -> Int
keepAliveTimeout T a
c,
      maxClients :: Int
maxClients            = T a -> Int
forall ext. T ext -> Int
maxClients T a
c,

      serverAdmin :: String
serverAdmin           = T a -> String
forall ext. T ext -> String
serverAdmin T a
c,
      serverName :: String
serverName            = T a -> String
forall ext. T ext -> String
serverName T a
c,
      serverAlias :: Set String
serverAlias           = T a -> Set String
forall ext. T ext -> Set String
serverAlias T a
c,
      useCanonicalName :: Bool
useCanonicalName      = T a -> Bool
forall ext. T ext -> Bool
useCanonicalName T a
c,
      hostnameLookups :: Bool
hostnameLookups       = T a -> Bool
forall ext. T ext -> Bool
hostnameLookups T a
c,

      documentRoot :: String
documentRoot          = T a -> String
forall ext. T ext -> String
documentRoot T a
c,
      accessFileName :: String
accessFileName        = T a -> String
forall ext. T ext -> String
accessFileName T a
c,
      indexes :: Bool
indexes               = T a -> Bool
forall ext. T ext -> Bool
indexes T a
c,
      followSymbolicLinks :: Bool
followSymbolicLinks   = T a -> Bool
forall ext. T ext -> Bool
followSymbolicLinks T a
c,
      chunkSize :: Int
chunkSize             = T a -> Int
forall ext. T ext -> Int
chunkSize T a
c,

      typesConfig :: String
typesConfig           = T a -> String
forall ext. T ext -> String
typesConfig T a
c,
      defaultType :: String
defaultType           = T a -> String
forall ext. T ext -> String
defaultType T a
c,

      addLanguage :: [(String, String)]
addLanguage           = T a -> [(String, String)]
forall ext. T ext -> [(String, String)]
addLanguage T a
c,
      languagePriority :: [String]
languagePriority      = T a -> [String]
forall ext. T ext -> [String]
languagePriority T a
c,

      customLogs :: [(String, String)]
customLogs            = T a -> [(String, String)]
forall ext. T ext -> [(String, String)]
customLogs T a
c,

      errorLogFile :: String
errorLogFile          = T a -> String
forall ext. T ext -> String
errorLogFile T a
c,
      logLevel :: T
logLevel              = T a -> T
forall ext. T ext -> T
logLevel T a
c,

      extension :: b
extension             = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ T a -> a
forall ext. T ext -> ext
extension T a
c
   }