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

import qualified Data.Set as Set


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

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

        encodeBearer =<< bearerToken (HashSet.singleton . 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

    showMetricName metricName mSamples = Set.size (Set.fromList sampleBasenames) > 1
      where
        sampleBasenames = do
          Sample sName _ _ <- mSamples
          return $ metricBasename metricName sName