{-# 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 ()