69 lines
2.1 KiB
Haskell
69 lines
2.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
module Config() where
|
|
|
|
import Toml (TomlCodec, (.=))
|
|
import qualified Toml
|
|
|
|
-- this module should handle everything connected to our TOML config
|
|
#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
|
|
import Data.String
|
|
import qualified Network.Wai.Handler.Warp as HTTP
|
|
#endif
|
|
|
|
#ifdef HTTPS_SUPPORT
|
|
import qualified Network.Wai.Handler.WarpTLS as HTTPS
|
|
#endif
|
|
|
|
data Configuration = Configuration {
|
|
#ifdef HTTP_SUPPORT
|
|
httpConf :: [HTTP.Settings]
|
|
#endif
|
|
#ifdef HTTPS_SUPPORT
|
|
httpsConf :: [(HTTP.Settings,HTTPS.TLSSettings)]
|
|
#endif
|
|
#ifdef FASTCGI_SUPPORT
|
|
fastCgiConf :: [FastCgiConfiguration]
|
|
#endif
|
|
#ifdef CGI_SUPPORT
|
|
cgiConf :: [CgiConfiguration]
|
|
#endif
|
|
}
|
|
|
|
#ifdef FASTCGI_SUPPORT
|
|
data FastCgiConfiguration = FastCgiConfiguration
|
|
#endif
|
|
|
|
#ifdef CGI_SUPPORT
|
|
data CgiConfiguration = CgiConfiguration
|
|
#endif
|
|
|
|
#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
|
|
|
|
-- this should not need to exist!!! It is realy ugly crap, but the only we to construct and deconstruct
|
|
-- this datatype is via fromString, read, show. And as we want the fromString syntax we want an inverse
|
|
-- of it too, but we don't get something nice exposed. Also we don't get the constructors exposed so we
|
|
-- pattern match on Strings, this is a hack!!!
|
|
httpShowHostPreference :: HTTP.HostPreference -> String
|
|
httpShowHostPreference pref = case show pref of
|
|
"HostAny" -> "*"
|
|
"HostIPv4" -> "*4"
|
|
"HostIPv4Only" -> "!4"
|
|
"HostIPv6" -> "*6"
|
|
"HostIPv6Only" -> "!6"
|
|
x -> drop 6 $ init x
|
|
-- why a String? Why is the only way to generate a HostPreference by its IsString instance?
|
|
-- why does warp not expose its constructors??
|
|
httpConfigConstructor :: Int -> String -> HTTP.Settings
|
|
httpConfigConstructor port bind = HTTP.setPort port $ HTTP.setHost (fromString bind) HTTP.defaultSettings
|
|
httpConfigCodec :: TomlCodec HTTP.Settings
|
|
httpConfigCodec = httpConfigConstructor
|
|
<$> Toml.int "Port" .= HTTP.getPort
|
|
<*> Toml.string "Bind" .= (httpShowHostPreference . HTTP.getHost)
|
|
#endif
|
|
|
|
configurationCodec :: TomlCodec Configuration
|
|
configurationCodec = pure Configuration
|
|
#ifdef HTTP_SUPPORT
|
|
<*> Toml.list httpConfigCodec "http" .= httpConf
|
|
#endif
|