85 lines
2.9 KiB
Haskell
85 lines
2.9 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
#ifndef HTTPS_SUPPORT
|
|
module Backend.Https
|
|
where
|
|
|
|
#else
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Backend.Https (forkHttpsBackend, httpsDefaultSettings) where
|
|
|
|
import Backend.Http
|
|
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
|
|
import qualified Network.Wai.Handler.Warp as HTTP
|
|
import qualified Network.Wai.Handler.WarpTLS as HTTPS
|
|
import Toml (TomlCodec, (.=))
|
|
import qualified Toml
|
|
import Control.Monad.IO.Class
|
|
import Environment
|
|
|
|
type HttpsConfiguration = (HttpConfiguration, TLSConfiguration)
|
|
|
|
data TLSConfiguration = TLSConfiguration
|
|
{ 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 {
|
|
certFile = setConfigM "certificate.pem",
|
|
certChain = setConfigM [],
|
|
keyFile = setConfigM "key.pem"
|
|
}
|
|
|
|
httpsDefaultSetting :: HttpsConfiguration
|
|
httpsDefaultSetting = (HttpConfiguration (setConfigM "https") (setConfigM 443) (setConfigM "*"), tlsDefaultSetting)
|
|
|
|
httpsDefaultSettings :: [HttpsConfiguration]
|
|
httpsDefaultSettings = [httpsDefaultSetting]
|
|
|
|
httpsConfigCodec' :: TomlCodec TLSConfiguration
|
|
httpsConfigCodec' =
|
|
TLSConfiguration
|
|
<$> 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'
|
|
|
|
httpsConfigsCodec :: TomlCodec [HttpsConfiguration]
|
|
httpsConfigsCodec = Toml.list httpsConfigCodec "https"
|
|
|
|
forkHttpsBackend :: Wai.Application -> FilePath -> EnvM [MVar ()]
|
|
forkHttpsBackend app = forkWithConfigs (backend app) httpsConfigsCodec
|
|
|
|
httpsToWarpTLSConfig :: HttpsConfiguration -> HTTPS.TLSSettings
|
|
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
|
|
|
|
backend :: Wai.Application -> HttpsConfiguration -> EnvM ()
|
|
backend app conf = liftIO $ HTTPS.runTLS (httpsToWarpTLSConfig conf) (httpsToWarpConfig conf) app
|
|
#endif
|