{-# LANGUAGE OverloadedStrings #-}

module System.Metrics.Prometheus.Http.Scrape
       ( Path
       , serveHttpTextMetrics
       , serveHttpTextMetricsT
       , prometheusApp
       )
       where

import           Control.Applicative                            ((<$>))
import           Control.Monad.IO.Class                         (MonadIO,
                                                                 liftIO)
import           Data.Text                                      (Text)
import           Network.HTTP.Types                             (hContentType,
                                                                 methodGet,
                                                                 status200,
                                                                 status404)
import           Network.Wai                                    (Application,
                                                                 Request,
                                                                 Response,
                                                                 pathInfo,
                                                                 requestMethod,
                                                                 responseBuilder,
                                                                 responseLBS)
import           Network.Wai.Handler.Warp                       (Port, run)

import           System.Metrics.Prometheus.Concurrent.RegistryT (RegistryT,
                                                                 sample)
import           System.Metrics.Prometheus.Encode.Text          (encodeMetrics)
import           System.Metrics.Prometheus.Registry             (RegistrySample)


-- | The HTTP web route on which to serve data
--
-- For example:
--
-- * @http://localhost:9090/metrics@ should use a path of @["metrics"]@.
-- * @http://localhost/@ should use a path of @[]@.
type Path = [Text]


serveHttpTextMetrics :: MonadIO m => Port -> Path -> IO RegistrySample -> m ()
serveHttpTextMetrics port path = liftIO . run port . prometheusApp path


serveHttpTextMetricsT :: MonadIO m => Port -> Path -> RegistryT m ()
serveHttpTextMetricsT port path = liftIO . serveHttpTextMetrics port path =<< sample


prometheusApp :: Path -> IO RegistrySample -> Application
prometheusApp path runSample request respond
    | isPrometheusRequest path request = respond =<< prometheusResponse <$> runSample
    | otherwise = respond response404
  where
    prometheusResponse = responseBuilder status200 headers . encodeMetrics
    headers = [(hContentType, "text/plain; version=0.0.4")]


response404 :: Response
response404 = responseLBS status404 header404 body404
  where
    header404 = [(hContentType, "text/plain")]
    body404 = "404"


isPrometheusRequest :: Path -> Request -> Bool
isPrometheusRequest path request = isGet && matchesPath
  where
    matchesPath = pathInfo request == path
    isGet = requestMethod request == methodGet