tickLeisteServer/app/Config.hs
2020-09-26 01:00:38 +02:00

117 lines
3.8 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Config(Configuration(..),defaultConfiguration,configurationCodec) where
import Toml (TomlCodec, (.=))
import qualified Toml
import System.IO
-- 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 {
cppDummy :: () -- this is a hack to get around the , rules of haskell records and the preprocessor
#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
defaultConfiguration :: Configuration
defaultConfiguration = Configuration ()
#ifdef HTTP_SUPPORT
[HTTP.defaultSettings]
#endif
#ifdef HTTPS_SUPPORT
[(HTTP.defaultSettings,HTTPS.defaultTlsSettings)]
#endif
#ifdef FASTCGI_SUPPORT
[FastCgiConfiguration]
#endif
#ifdef CGI_SUPPORT
[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
#ifdef HTTPS_SUPPORT
httpsConfigCodec :: TomlCodec (HTTP.Settings,HTTPS.TLSSettings)
httpsConfigCodec = Toml.pair httpConfigCodec httpsConfigCodec'
httpsConfigCodec' :: TomlCodec (HTTPS.TLSSettings)
httpsConfigCodec' = HTTPS.tlsSettingsChain
-- the hardcoded strings are a bloody hack, but we can't extract the values back out of a config (they are there
-- warp just doesn't export the neccesarry types). So we hardcode default values, which is kind of realy bad, but
-- we don't need it in our usecase
<$> Toml.string "Certificate" .= (const "certificate.pem")
<*> Toml.arrayOf Toml._String "CertChain" .= (const [])
<*> Toml.string "KeyFile" .= (const "key.pem")
#endif
#ifdef FASTCGI_SUPPORT
fastCgiConfigCodec :: TomlCodec FastCgiConfiguration
fastCgiConfigCodec = pure FastCgiConfiguration
#endif
#ifdef CGI_SUPPORT
cgiConfigCodec :: TomlCodec CgiConfiguration
cgiConfigCodec = pure CgiConfiguration
#endif
configurationCodec :: TomlCodec Configuration
configurationCodec = pure (Configuration ())
#ifdef HTTP_SUPPORT
<*> Toml.list httpConfigCodec "http" .= httpConf
#endif
#ifdef HTTPS_SUPPORT
<*> Toml.list httpsConfigCodec "https" .= httpsConf
#endif
#ifdef FASTCGI_SUPPORT
<*> Toml.list fastCgiConfigCodec "fast-cgi" .= fastCgiConf
#endif
#ifdef CGI_SUPPORT
<*> Toml.list cgiConfigCodec "cgi" .= cgiConf
#endif