content: {-# LANGUAGE RecordWildCards #-}
  
  -- | Utilities for interacting with our metrics library.
  --
  -- If possible, try to keep details specific to our current metrics libraries isolated to
  -- within this module so we can easily swap to new providers if needed.
  module Share.Metrics
    ( serveMetricsMiddleware,
      requestMetricsMiddleware,
      tickUserSignup,
      recordBackgroundImportDuration,
      recordDefinitionSearchIndexDuration,
      recordCausalDiffDuration,
      recordWebhookSendingDuration,
    )
  where
  
  import Control.Lens
  import Data.Ratio ((%))
  import Data.Set qualified as Set
  import Data.Text qualified as Text
  import Data.Text.Encoding
  import Data.Time qualified as Time
  import Network.HTTP.Types qualified as HTTP
  import Network.Wai qualified as Wai
  import Network.Wai.Middleware.Prometheus qualified as Prom
  import Prometheus qualified as Prom
  import Prometheus.Metric.GHC qualified as Prom
  import Share.Env qualified as Env
  import Share.Postgres qualified as PG
  import Share.Postgres.Metrics.Queries qualified as Q
  import Share.Prelude
  import Share.Telemetry qualified as Trace
  import Share.Utils.Deployment qualified as Deployment
  import Share.Utils.Servant.PathInfo (HasPathInfo, normalizePath)
  import Share.Utils.Tags (HasTags (..))
  import Share.Utils.Tags qualified as Tags
  import System.Clock (Clock (..), diffTimeSpec, toNanoSecs)
  import System.Clock qualified as Clock
  import UnliftIO qualified
  
  service :: Text
  service = "share-api"
  
  deployment :: Text
  deployment = tShow Deployment.deployment
  
  metricUpdateInterval :: Time.NominalDiffTime
  metricUpdateInterval = 5 * 60 -- 5 mins
  
  -- | Low resolution metrics that are updated rarely.
  data SlowChangingMetrics = SlowChangingMetrics
    { uniqueUserPushesInWeek :: Int64,
      uniqueUserPushesInMonth :: Int64,
      uniqueUserPushesAllTime :: Int64,
      numTotalUsers :: Int64,
      numPublicProjects :: Int64,
      numPrivateProjects :: Int64,
      numTotalProjects :: Int64,
      releaseDownloadsLastDay :: Int64,
      releaseDownloadsLastWeek :: Int64,
      releaseDownloadsLastMonth :: Int64,
      -- Number of users with access to cloud.
      numCloudUsers :: Int64,
      -- Number of total public definitions on /main branch of all Share projects
      numTotalPublicDefinitions :: Int64,
      -- Number of total public or private definitions on /main branch of all Share projects
      numTotalPublicOrPrivateDefinitions :: Int64,
      usersWithContributions :: Int64,
      usersWithTickets :: Int64,
      causalDiffQueueEntriesCount :: Int64
    }
  
  -- | Serves the app's prometheus metrics at `/metrics`
  serveMetricsMiddleware :: (HasTags x) => Env.Env x -> IO Wai.Middleware
  serveMetricsMiddleware env = do
    Prom.register Prom.ghcMetrics
    getMetrics <- atMostOnceEveryInterval metricUpdateInterval $ do
      now <- Time.getCurrentTime
      runPG (queryMetrics now)
    pure \app req handleResponse -> do
      refreshGauges getMetrics
      Prom.prometheus prometheusSettings app req handleResponse
    where
      runPG pg = do
        tags <- getTags env
        pg
          & PG.transaction PG.ReadCommitted PG.Read
          & PG.runSessionWithEnv env
          & Trace.runTracerT (Env.tracer env)
          & Tags.runTagT tags
      prometheusSettings =
        Prom.def
          { Prom.prometheusEndPoint = ["metrics"],
            Prom.prometheusInstrumentApp = False,
            Prom.prometheusInstrumentPrometheus = False
          }
  
  -- | Record an event to the middleware metric.
  requestMetricsMiddleware :: (HasPathInfo api) => Proxy api -> Wai.Middleware
  requestMetricsMiddleware api app req handleResponse = do
    if recordRequest req
      then do
        start <- Clock.getTime Monotonic
        app req $ \resp ->
          do
            end <- Clock.getTime Monotonic
            let method = Just $ decodeUtf8 (Wai.requestMethod req)
            -- There's probably some nice way to do this with Servant.
            let path = Text.intercalate "/" <$> normalizePath api (Wai.pathInfo req)
            let status = Just $ Text.pack (show (HTTP.statusCode (Wai.responseStatus resp)))
            result <- handleResponse resp
            recordLatency
              requestLatency
              (tShow Deployment.deployment, service, fromMaybe "" method, fromMaybe "" status, fromMaybe "unknown-path" path)
              start
              end
            pure result
      else app req handleResponse
    where
      ignoredPaths = Set.fromList [["health"], ["metrics"]]
      recordRequest req = Set.notMember (Wai.pathInfo req) ignoredPaths
  
  {-# NOINLINE requestLatency #-}
  requestLatency :: Prom.Vector Prom.Label5 Prom.Histogram
  requestLatency =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service", "method", "status_code", "path") $
        Prom.histogram info Prom.defaultBuckets
    where
      info =
        Prom.Info
          "http_request_duration_seconds"
          "The HTTP request latencies in seconds."
  
  {-# NOINLINE userSignupsCounter #-}
  userSignupsCounter :: Prom.Vector Prom.Label2 Prom.Counter
  userSignupsCounter =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.counter info
    where
      info =
        Prom.Info
          "user_signups_count"
          "The total number of users registered with share"
  
  {-# NOINLINE totalUsersGauge #-}
  totalUsersGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  totalUsersGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "total_registered_users"
          "The number of registered users."
  
  {-# NOINLINE publicProjectsGauge #-}
  publicProjectsGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  publicProjectsGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "total_public_projects"
          "The number of public projects."
  
  {-# NOINLINE privateProjectsGauge #-}
  privateProjectsGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  privateProjectsGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "total_private_projects"
          "The number of private projects."
  
  {-# NOINLINE totalProjectsGauge #-}
  totalProjectsGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  totalProjectsGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "total_projects"
          "The total number of projects."
  
  {-# NOINLINE releaseDownloadsLastDayGauge #-}
  releaseDownloadsLastDayGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  releaseDownloadsLastDayGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "release_downloads_last_day"
          "The total number of release downloads over the last day."
  
  {-# NOINLINE releaseDownloadsLastWeekGauge #-}
  releaseDownloadsLastWeekGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  releaseDownloadsLastWeekGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "release_downloads_last_week"
          "The total number of release downloads over the last week."
  
  {-# NOINLINE releaseDownloadsLastMonthGauge #-}
  releaseDownloadsLastMonthGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  releaseDownloadsLastMonthGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "release_downloads_last_month"
          "The total number of release downloads over the last month."
  
  {-# NOINLINE numCloudUsersGauge #-}
  numCloudUsersGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  numCloudUsersGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "num_cloud_users"
          "The number of users with access to cloud."
  
  {-# NOINLINE numTotalPublicOrPrivateDefinitionsGauge #-}
  numTotalPublicOrPrivateDefinitionsGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  numTotalPublicOrPrivateDefinitionsGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "num_total_public_or_private_definitions"
          "The number of total definitions on /main branch of all Share projects (including private projects)."
  
  {-# NOINLINE numTotalPublicDefinitionsGauge #-}
  numTotalPublicDefinitionsGauge :: Prom.Vector Prom.Label2 Prom.Gauge
  numTotalPublicDefinitionsGauge =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "num_total_public_definitions"
          "The number of total definitions on /main branch of all public Share projects"
  
  numUsersWithContributions :: Prom.Vector Prom.Label2 Prom.Gauge
  numUsersWithContributions =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info = Prom.Info "num_users_with_contributions" "The number of users who have interacted contributions."
  
  numUsersWithTickets :: Prom.Vector Prom.Label2 Prom.Gauge
  numUsersWithTickets =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info = Prom.Info "num_users_with_tickets" "The number of users who have interacted with tickets."
  
  -- | Adds one to the user-signup counter
  tickUserSignup :: (MonadIO m) => m ()
  tickUserSignup = liftIO do
    Prom.withLabel userSignupsCounter (tShow Deployment.deployment, "share-api") Prom.incCounter
  
  -- | Runs the provided action at most once every interval, will return previous results until
  -- it's time to run again.
  --
  -- This is useful for metrics that are expensive to compute and don't change often.
  atMostOnceEveryInterval :: Time.NominalDiffTime -> IO a -> IO (IO a)
  atMostOnceEveryInterval interval action = do
    lastRunRef <- UnliftIO.newMVar Nothing
    pure do
      now <- Time.getCurrentTime
      UnliftIO.modifyMVar lastRunRef \cached -> do
        case cached of
          Just (lastRunTime, result) ->
            if now `Time.diffUTCTime` lastRunTime < interval
              then pure (Just (lastRunTime, result), result)
              else refresh
          Nothing -> refresh
    where
      refresh = do
        result <- action
        now <- Time.getCurrentTime
        pure $ (Just (now, result), result)
  
  -- | A collection of metrics that are expensive to compute and don't change often.
  queryMetrics :: Time.UTCTime -> PG.Transaction e SlowChangingMetrics
  queryMetrics now = do
    uniqueUserPushesInWeek <- Q.numUniqueUsersPushedSince (Time.addUTCTime ((-7) * Time.nominalDay) now)
    uniqueUserPushesInMonth <- Q.numUniqueUsersPushedSince (Time.addUTCTime ((-30) * Time.nominalDay) now)
    uniqueUserPushesAllTime <- Q.numUniqueUsersWithAPush
    numTotalUsers <- Q.allUsersCount
    (numPrivateProjects, numPublicProjects, numTotalProjects) <- Q.allProjectsCount
    (releaseDownloadsLastDay, releaseDownloadsLastWeek, releaseDownloadsLastMonth) <- Q.releaseDownloadsGauges
    numCloudUsers <- Q.numCloudUsers
    numTotalPublicOrPrivateDefinitions <- Q.numTotalPublicOrPrivateDefinitions
    numTotalPublicDefinitions <- Q.numTotalPublicDefinitions
    usersWithContributions <- Q.usersInteractedWithContributions
    usersWithTickets <- Q.usersInteractedWithTickets
    causalDiffQueueEntriesCount <- Q.numCausalDiffQueueEntries
    pure SlowChangingMetrics {..}
  
  -- | Since some time-based metrics will change due to the passage of time rather than any
  -- specific user action, we just refresh them whenever prometheus queries metrics for them.
  -- Ensure that any queries here aren't too expensive since they'll be run often.
  refreshGauges :: IO SlowChangingMetrics -> IO ()
  refreshGauges getMetrics = do
    SlowChangingMetrics {..} <- getMetrics
    Prom.withLabel numUniqueAccountsWithAPushInLastWeek (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral uniqueUserPushesInWeek)
    Prom.withLabel numUniqueAccountsWithAPushInLastMonth (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral uniqueUserPushesInMonth)
    Prom.withLabel numUniqueAccountsWithAtLeastOnePush (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral uniqueUserPushesAllTime)
    Prom.withLabel totalUsersGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral numTotalUsers)
  
    Prom.withLabel privateProjectsGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral numPrivateProjects)
    Prom.withLabel publicProjectsGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral numPublicProjects)
    Prom.withLabel totalProjectsGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral numTotalProjects)
  
    Prom.withLabel releaseDownloadsLastDayGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral releaseDownloadsLastDay)
    Prom.withLabel releaseDownloadsLastWeekGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral releaseDownloadsLastWeek)
    Prom.withLabel releaseDownloadsLastMonthGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral releaseDownloadsLastMonth)
  
    Prom.withLabel numCloudUsersGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral numCloudUsers)
    Prom.withLabel numTotalPublicOrPrivateDefinitionsGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral numTotalPublicOrPrivateDefinitions)
    Prom.withLabel numTotalPublicDefinitionsGauge (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral numTotalPublicDefinitions)
  
    Prom.withLabel numUsersWithContributions (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral usersWithContributions)
    Prom.withLabel numUsersWithTickets (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral usersWithTickets)
  
    Prom.withLabel numCausalDiffQueueEntries (deployment, service) \gauge -> Prom.setGauge gauge (fromIntegral causalDiffQueueEntriesCount)
  
  {-# NOINLINE numUniqueAccountsWithAPushInLastWeek #-}
  numUniqueAccountsWithAPushInLastWeek :: Prom.Vector Prom.Label2 Prom.Gauge
  numUniqueAccountsWithAPushInLastWeek =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "unique_users_with_push_in_last_week_count"
          "The number of unique users with at least one push in the last week."
  
  {-# NOINLINE numUniqueAccountsWithAPushInLastMonth #-}
  numUniqueAccountsWithAPushInLastMonth :: Prom.Vector Prom.Label2 Prom.Gauge
  numUniqueAccountsWithAPushInLastMonth =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "unique_users_with_push_in_last_month_count"
          "The number of unique users with at least one push in the last 30 days."
  
  {-# NOINLINE numUniqueAccountsWithAtLeastOnePush #-}
  numUniqueAccountsWithAtLeastOnePush :: Prom.Vector Prom.Label2 Prom.Gauge
  numUniqueAccountsWithAtLeastOnePush =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "unique_users_with_at_least_one_push_count"
          "The number of unique users with at least one push over all time."
  
  {-# NOINLINE backgroundImportDurationSeconds #-}
  backgroundImportDurationSeconds :: Prom.Vector Prom.Label2 Prom.Histogram
  backgroundImportDurationSeconds =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.histogram info Prom.defaultBuckets
    where
      info =
        Prom.Info
          "background_codebase_import_duration_seconds"
          "The time it took to import a pulled branch into the user's codebase."
  
  {-# NOINLINE definitionSearchIndexDurationSeconds #-}
  definitionSearchIndexDurationSeconds :: Prom.Vector Prom.Label2 Prom.Histogram
  definitionSearchIndexDurationSeconds =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.histogram info Prom.defaultBuckets
    where
      info =
        Prom.Info
          "definition_search_indexing_duration_seconds"
          "The time it took to index a release for definition search"
  
  {-# NOINLINE contributionDiffDurationSeconds #-}
  contributionDiffDurationSeconds :: Prom.Vector Prom.Label2 Prom.Histogram
  contributionDiffDurationSeconds =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.histogram info Prom.defaultBuckets
    where
      info =
        Prom.Info
          "contribution_diff_duration_seconds"
          "The time it took to compute a contribution diff"
  
  {-# NOINLINE webhookSendingDurationSeconds #-}
  webhookSendingDurationSeconds :: Prom.Vector Prom.Label2 Prom.Histogram
  webhookSendingDurationSeconds =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.histogram info Prom.defaultBuckets
    where
      info =
        Prom.Info
          "webhook_sending_duration_seconds"
          "The time it took to send a notification webhook"
  
  {-# NOINLINE numCausalDiffQueueEntries #-}
  numCausalDiffQueueEntries :: Prom.Vector Prom.Label2 Prom.Gauge
  numCausalDiffQueueEntries =
    Prom.unsafeRegister $
      Prom.vector ("deployment", "service") $
        Prom.gauge info
    where
      info =
        Prom.Info
          "causal_diff_queue_entries_count"
          "The number of causal diffs in the queue."
  
  timeActionIntoHistogram :: (Prom.Label l, MonadUnliftIO m) => (Prom.Vector l Prom.Histogram) -> l -> m c -> m c
  timeActionIntoHistogram histogram l m = do
    startTime <- liftIO $ Clock.getTime Monotonic
    m `UnliftIO.finally` do
      liftIO do
        endTime <- Clock.getTime Monotonic
        recordLatency histogram l startTime endTime
  
  recordLatency :: (Prom.Label l) => (Prom.Vector l Prom.Histogram) -> l -> Clock.TimeSpec -> Clock.TimeSpec -> IO ()
  recordLatency histogram l startTime endTime = do
    let latency :: Double
        latency = fromRational (toNanoSecs (endTime `diffTimeSpec` startTime) % 1000000000)
    Prom.withLabel histogram l (flip Prom.observe latency)
  
  -- | Record the duration of a background import.
  recordBackgroundImportDuration :: (MonadUnliftIO m) => m r -> m r
  recordBackgroundImportDuration = timeActionIntoHistogram backgroundImportDurationSeconds (deployment, service)
  
  -- | Record the duration of creating a search index for a release
  recordDefinitionSearchIndexDuration :: (MonadUnliftIO m) => m r -> m r
  recordDefinitionSearchIndexDuration = timeActionIntoHistogram definitionSearchIndexDurationSeconds (deployment, service)
  
  recordCausalDiffDuration :: Clock.TimeSpec -> IO ()
  recordCausalDiffDuration startTime = do
    endTime <- Clock.getTime Monotonic
    recordLatency contributionDiffDurationSeconds (deployment, service) startTime endTime
  
  -- | Record the duration of sending a webhook.
  recordWebhookSendingDuration :: (MonadUnliftIO m) => m r -> m r
  recordWebhookSendingDuration = timeActionIntoHistogram webhookSendingDurationSeconds (deployment, service)
  