diff options
Diffstat (limited to 'Com/MusicMeetsComics/Server/Init.hs')
-rw-r--r-- | Com/MusicMeetsComics/Server/Init.hs | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/Com/MusicMeetsComics/Server/Init.hs b/Com/MusicMeetsComics/Server/Init.hs new file mode 100644 index 0000000..7ad3ebf --- /dev/null +++ b/Com/MusicMeetsComics/Server/Init.hs @@ -0,0 +1,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 shutdownApp 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 +shutdownApp :: Config.Config -> IO () +shutdownApp 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 () |