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

wrapped everything in the EnvM Monad, the logging might commence

Browse source
This commit is contained in:
Dennis Frieberg 2021-04-05 22:11:07 +02:00
parent 27a51c2121
commit ac303abcc0
7 changed files with 78 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

10
app/Backend/Https.hs
View file

@ -18,6 +18,8 @@ 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)
@ -63,8 +65,8 @@ httpsConfigCodec = Toml.pair httpConfigCodec httpsConfigCodec'
httpsConfigsCodec :: TomlCodec [HttpsConfiguration]
httpsConfigsCodec = Toml.list httpsConfigCodec "https"
forkHttpsBackend :: Wai.Application -> FilePath -> IO [MVar ()]
forkHttpsBackend app configFile = forkWithConfigs (backend app) httpsConfigsCodec configFile
forkHttpsBackend :: Wai.Application -> FilePath -> EnvM [MVar ()]
forkHttpsBackend app = forkWithConfigs (backend app) httpsConfigsCodec
httpsToWarpTLSConfig :: HttpsConfiguration -> HTTPS.TLSSettings
httpsToWarpTLSConfig (_, tlsConfig) = HTTPS.tlsSettingsChain confCerfFile confCertChain confKeyFile
@ -78,6 +80,6 @@ httpsToWarpTLSConfig (_, tlsConfig) = HTTPS.tlsSettingsChain confCerfFile confCe
httpsToWarpConfig :: HttpsConfiguration -> HTTP.Settings
httpsToWarpConfig = httpToWarpConfig . fst
backend :: Wai.Application -> HttpsConfiguration -> IO ()
backend app conf = HTTPS.runTLS (httpsToWarpTLSConfig conf) (httpsToWarpConfig conf) app
backend :: Wai.Application -> HttpsConfiguration -> EnvM ()
backend app conf = liftIO $ HTTPS.runTLS (httpsToWarpTLSConfig conf) (httpsToWarpConfig conf) app
#endif