{-# LANGUAGE OverloadedStrings #-}
module MetricsServer where

import           Data.Function                     ((&))
import           Data.Monoid                       ((<>))
import qualified Data.Text                         as Text
import qualified Network.Wai.Handler.Warp          as Warp
import qualified Network.Wai.Middleware.Prometheus as PrometheusWai

import           Config                            (MetricsConfig (..))
import           Logger                            (Logger, LogLevel(..), postLog)

metricsServerConfig :: MetricsConfig -> Warp.Settings
metricsServerConfig :: MetricsConfig -> Settings
metricsServerConfig MetricsConfig
config = Settings
Warp.defaultSettings
  Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& HostPreference -> Settings -> Settings
Warp.setHost (MetricsConfig -> HostPreference
metricsConfigHost MetricsConfig
config)
  Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& Port -> Settings -> Settings
Warp.setPort (MetricsConfig -> Port
metricsConfigPort MetricsConfig
config)

runMetricsServer :: Logger -> MetricsConfig -> IO ()
runMetricsServer :: Logger -> MetricsConfig -> IO ()
runMetricsServer Logger
logger MetricsConfig
metricsConfig = do
  Logger -> LogLevel -> LogRecord -> IO ()
Logger.postLog Logger
logger LogLevel
LogInfo (LogRecord -> IO ()) -> LogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ LogRecord
"Metrics provided on "
    LogRecord -> LogRecord -> LogRecord
forall a. Semigroup a => a -> a -> a
<> (String -> LogRecord
Text.pack (String -> LogRecord) -> String -> LogRecord
forall a b. (a -> b) -> a -> b
$ HostPreference -> String
forall a. Show a => a -> String
show (HostPreference -> String) -> HostPreference -> String
forall a b. (a -> b) -> a -> b
$ MetricsConfig -> HostPreference
metricsConfigHost MetricsConfig
metricsConfig)
    LogRecord -> LogRecord -> LogRecord
forall a. Semigroup a => a -> a -> a
<> LogRecord
":"
    LogRecord -> LogRecord -> LogRecord
forall a. Semigroup a => a -> a -> a
<> (String -> LogRecord
Text.pack (String -> LogRecord) -> String -> LogRecord
forall a b. (a -> b) -> a -> b
$ Port -> String
forall a. Show a => a -> String
show (Port -> String) -> Port -> String
forall a b. (a -> b) -> a -> b
$ MetricsConfig -> Port
metricsConfigPort MetricsConfig
metricsConfig)
  Settings -> Application -> IO ()
Warp.runSettings (MetricsConfig -> Settings
metricsServerConfig MetricsConfig
metricsConfig) Application
PrometheusWai.metricsApp