module Handler.Metrics
  ( getMetricsR
  ) where

import Import hiding (Info)

import Prometheus
import qualified Network.Wai.Middleware.Prometheus as Prometheus

import qualified Data.Text as Text
import qualified Data.HashSet as HashSet


getMetricsR :: Handler TypedContent
getMetricsR = selectRep $ do
  provideRep (sendWaiApplication Prometheus.metricsApp :: Handler Text)
  provideRep metricsHtml
  provideRep $ collectMetrics >>= returnJson
  where
    metricsHtml :: Handler Html
    metricsHtml = do
      samples <- collectMetrics

      metricsToken <- runMaybeT . hoist runDB $ do
        uid <- MaybeT maybeAuthId
        guardM . lift . existsBy $ UniqueUserGroupMember UserGroupMetrics uid

        encodeToken =<< bearerToken (Left $ toJSON UserGroupMetrics) (Just $ HashSet.singleton MetricsR) Nothing (Just Nothing) Nothing
  
      defaultLayout $ do
        setTitleI MsgTitleMetrics
        $(widgetFile "metrics")

    metricBasename base sName
      | Just suffix <- Text.stripPrefix base sName
      = if | Just suffix' <- Text.stripPrefix "_" suffix
             -> suffix'
           | otherwise
             -> suffix
      | otherwise
      = sName
    getLabels = nub . concatMap (\(Sample _ lPairs _) -> lPairs ^.. folded . _1)
    singleSample base [Sample sName lPairs sValue]
      | sName == base = Just (lPairs, sValue)
    singleSample _ _ = Nothing
