blob: 04ddc8877d8399a64acbefde2848029d40d256b4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Com.MusicMeetsComics.Server.Init where
import qualified Com.MusicMeetsComics.Server.Config as Config
import Control.Concurrent (killThread)
import Control.Exception (bracket)
import qualified Control.Monad.Metrics as M
import qualified Katip
import Lens.Micro ((^.))
import Network.Wai (Application, Middleware)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Metrics (metrics, registerWaiMetrics)
import Network.Wai.Middleware.Gzip
import Protolude
import qualified System.IO as IO
-- | An action that creates a WAI 'Application' together with its resources,
-- runs it, and tears it down on exit
runApp :: (Config.Config -> Application) -> IO ()
runApp app = bracket Config.acquire shutdown jog
where
say = IO.hPutStrLn IO.stderr
jog config = do
say $ "hero"
say $ "port: " ++ show (Config.configPort config)
run (Config.configPort config) =<< initialize app config
-- | The 'initialize' function accepts the required environment information,
-- initializes the WAI 'Application' and returns it
initialize :: (Config.Config -> Application) -> Config.Config -> IO Application
initialize app cfg = do
waiMetrics <- registerWaiMetrics (Config.configMetrics cfg ^. M.metricsStore)
let logger = Config.setLogger (Config.configEnv cfg)
-- generateJavaScript
pure . logger . metrics waiMetrics . app $ cfg
compress :: Middleware
compress = gzip def { gzipFiles = GzipCompress }
-- | Takes care of cleaning up 'Config.Config' resources
shutdown :: Config.Config -> IO ()
shutdown cfg = do
_ <- Katip.closeScribes (Config.configLogEnv cfg)
-- Monad.Metrics does not provide a function to destroy metrics store
-- so, it'll hopefully get torn down when async exception gets thrown
-- at metrics server process
killThread (Config.configEkgServer cfg)
pure ()
|
