Splittertech/tickLeisteServer
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

redone backend handling and config parsing

Browse source
This commit is contained in:
Dennis Frieberg 2021-03-18 15:31:59 +01:00
parent 4733c3e3e2
commit c4a1a442f3
9 changed files with 177 additions and 166 deletions
Download patch file Download diff file Expand all files Collapse all files

41
app/Backend/Https.hs
View file

@ -3,7 +3,8 @@
module Backend.Https (forkHttpsBackend, httpsDefaultSettings) where
import Backend.Http
import Config
import Config hiding (ConfigM,configM)
import qualified Config as Toml (configM,ConfigM)
import Control.Concurrent.MVar (MVar)
import Data.Text () -- we only need the isString instance to generate literals
import qualified Network.Wai as Wai
@ -15,16 +16,30 @@ import qualified Toml
type HttpsConfiguration = (HttpConfiguration, TLSConfiguration)
data TLSConfiguration = TLSConfiguration
{ certFile :: FilePath,
certChain :: [FilePath],
keyFile :: FilePath
{ certFile :: Toml.ConfigM FilePath,
certChain :: Toml.ConfigM [FilePath],
keyFile :: Toml.ConfigM FilePath
}
instance Semigroup TLSConfiguration where
a <> b = TLSConfiguration {
certFile = certFile a <> certFile b,
certChain = certChain a <> certChain b,
keyFile = keyFile a <> keyFile b
}
instance Monoid TLSConfiguration where
mempty = TLSConfiguration mempty mempty mempty
tlsDefaultSetting :: TLSConfiguration
tlsDefaultSetting = TLSConfiguration "certificate.pem" [] "key.pem"
tlsDefaultSetting = TLSConfiguration {
certFile = setConfigM "certificate.pem",
certChain = setConfigM [],
keyFile = setConfigM "key.pem"
}
httpsDefaultSetting :: HttpsConfiguration
httpsDefaultSetting = (HttpConfiguration "https" 443 "*", tlsDefaultSetting)
httpsDefaultSetting = (HttpConfiguration (setConfigM "https") (setConfigM 443) (setConfigM "*"), tlsDefaultSetting)
httpsDefaultSettings :: [HttpsConfiguration]
httpsDefaultSettings = [httpsDefaultSetting]
@ -32,9 +47,9 @@ httpsDefaultSettings = [httpsDefaultSetting]
httpsConfigCodec' :: TomlCodec TLSConfiguration
httpsConfigCodec' =
TLSConfiguration
<$> Toml.string "Certificate" .= certFile
<*> Toml.arrayOf Toml._String "CertChain" .= certChain
<*> Toml.string "KeyFile" .= keyFile
<$> Toml.configM Toml.string "Certificate" .= certFile
<*> Toml.configM (Toml.arrayOf Toml._String) "CertChain" .= certChain
<*> Toml.configM Toml.string "KeyFile" .= keyFile
httpsConfigCodec :: TomlCodec HttpsConfiguration
httpsConfigCodec = Toml.pair httpConfigCodec httpsConfigCodec'
@ -46,7 +61,13 @@ forkHttpsBackend :: Wai.Application -> FilePath -> IO [MVar ()]
forkHttpsBackend app configFile = forkWithConfigs (backend app) httpsConfigsCodec configFile
httpsToWarpTLSConfig :: HttpsConfiguration -> HTTPS.TLSSettings
httpsToWarpTLSConfig (_, tlsConfig) = HTTPS.tlsSettingsChain (certFile tlsConfig) (certChain tlsConfig) (keyFile tlsConfig)
httpsToWarpTLSConfig (_, tlsConfig) = HTTPS.tlsSettingsChain confCerfFile confCertChain confKeyFile
where
-- this has always all options set so getConfigM is safe
config = tlsConfig <> tlsDefaultSetting
confCerfFile = getConfigM $ certFile config
confCertChain = getConfigM $ certChain config
confKeyFile = getConfigM $ keyFile config
httpsToWarpConfig :: HttpsConfiguration -> HTTP.Settings
httpsToWarpConfig = httpToWarpConfig . fst