{-# LANGUAGE OverloadedStrings #-}

module System.Metrics.Prometheus.Http.Scrape
       ( Path
       , serveMetrics
       , serveMetricsT
       , 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]


serveMetrics :: MonadIO m => Port -> Path -> IO RegistrySample -> m ()
serveMetrics :: Port -> Path -> IO RegistrySample -> m ()
serveMetrics Port
port Path
path = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (IO RegistrySample -> IO ()) -> IO RegistrySample -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Application -> IO ()
run Port
port (Application -> IO ())
-> (IO RegistrySample -> Application) -> IO RegistrySample -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> IO RegistrySample -> Application
prometheusApp Path
path


serveMetricsT :: MonadIO m => Port -> Path -> RegistryT m ()
serveMetricsT :: Port -> Path -> RegistryT m ()
serveMetricsT Port
port Path
path = IO () -> RegistryT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RegistryT m ())
-> (IO RegistrySample -> IO ())
-> IO RegistrySample
-> RegistryT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Path -> IO RegistrySample -> IO ()
forall (m :: * -> *).
MonadIO m =>
Port -> Path -> IO RegistrySample -> m ()
serveMetrics Port
port Path
path (IO RegistrySample -> RegistryT m ())
-> RegistryT m (IO RegistrySample) -> RegistryT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RegistryT m (IO RegistrySample)
forall (m :: * -> *). Monad m => RegistryT m (IO RegistrySample)
sample


prometheusApp :: Path -> IO RegistrySample -> Application
prometheusApp :: Path -> IO RegistrySample -> Application
prometheusApp Path
path IO RegistrySample
runSample Request
request Response -> IO ResponseReceived
respond
    | Path -> Request -> Bool
isPrometheusRequest Path
path Request
request = Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> IO Response -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RegistrySample -> Response
prometheusResponse (RegistrySample -> Response) -> IO RegistrySample -> IO Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RegistrySample
runSample
    | Bool
otherwise = Response -> IO ResponseReceived
respond Response
response404
  where
    prometheusResponse :: RegistrySample -> Response
prometheusResponse = Status -> ResponseHeaders -> Builder -> Response
responseBuilder Status
status200 ResponseHeaders
headers (Builder -> Response)
-> (RegistrySample -> Builder) -> RegistrySample -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegistrySample -> Builder
encodeMetrics
    headers :: ResponseHeaders
headers = [(HeaderName
hContentType, ByteString
"text/plain; version=0.0.4")]


response404 :: Response
response404 :: Response
response404 = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status404 ResponseHeaders
header404 ByteString
body404
  where
    header404 :: ResponseHeaders
header404 = [(HeaderName
hContentType, ByteString
"text/plain")]
    body404 :: ByteString
body404 = ByteString
"404"


isPrometheusRequest :: Path -> Request -> Bool
isPrometheusRequest :: Path -> Request -> Bool
isPrometheusRequest Path
path Request
request = Bool
isGet Bool -> Bool -> Bool
&& Bool
matchesPath
  where
    matchesPath :: Bool
matchesPath = Request -> Path
pathInfo Request
request Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
path
    isGet :: Bool
isGet = Request -> ByteString
requestMethod Request
request ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
methodGet