-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

module Utils.Metrics
  ( withHealthReportMetrics
  , registerGHCMetrics
  , observeHTTPRequestLatency
  , registerReadyMetric
  , registerHealthCheckInterval
  , withJobWorkerState
  , observeYesodCacheSize
  , observeFavouritesQuickActionsDuration
  , LoginOutcome(..), observeLoginOutcome
  , registerJobHeldLocksCount
  , FileChunkStorage(..), observeSourcedChunk, observeSunkChunk
  , observeDeletedUnreferencedFiles, observeDeletedUnreferencedChunks, observeInjectedFiles, observeRechunkedFiles
  , registerJobWorkerQueueDepth
  , observeMissingFiles
  , ARCMetrics, ARCLabel(..)
  , arcMetrics
  , LRUMetrics, LRULabel(..)
  , lruMetrics
  , InjectInhibitMetrics, injectInhibitMetrics
  , PoolMetrics, PoolLabel(..)
  , poolMetrics
  , observeDatabaseConnectionOpened, observeDatabaseConnectionClosed
  , onUseDBConn, onReleaseDBConn, DBConnUseState, DBConnLabel
  , AuthTagEvalOutcome(..), observeAuthTagEvaluation
  , observeFavouritesSkippedDueToDBLoad
  ) where

import Import.NoModel hiding (Vector, Info)
import Model
import Prometheus
import Prometheus.Metric.GHC

import qualified Data.List as List

import System.Clock
import Data.Time.Clock.POSIX

import Network.Wai (Middleware)
import qualified Network.Wai as Wai
import qualified Network.HTTP.Types as HTTP

import Yesod.Core.Types (HandlerData(..), GHState(..))

import qualified Data.Set as Set

import Jobs.Types

import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap

import Data.IntervalMap.Strict (IntervalMap)
import qualified Data.IntervalMap.Strict as IntervalMap

import qualified Data.Foldable as F

import qualified Utils.Pool as Custom

import GHC.Stack

{-# ANN module ("HLint: ignore Use even" :: String) #-}


histogramBuckets :: Rational -- ^ min
                 -> Rational -- ^ max
                 -> [Double]
histogramBuckets bMin bMax = map fromRational . takeWhile (<= bMax) . go bMin $ List.cycle factors
  where
    go n []     = [n]
    go n (f:fs) = n : go (f * n) fs

    factors
      | bMin' `mod` 2 == 0 = [2.5, 2, 2]
      | bMin' `mod` 5 == 0 = [2, 2, 2.5]
      | otherwise          = [2, 2.5, 2]
      where
        bMin' :: Integer
        bMin' = floor . List.head . dropWhile (< 1) $ List.iterate (* 10) bMin


{-# NOINLINE healthReportTime #-}
healthReportTime :: Vector Label2 Gauge
healthReportTime = unsafeRegister . vector ("check", "status") $ gauge info
  where
    info = Info "uni2work_health_check_time"
                "POSIXTime of last health check performed by this Uni2work-instance"

{-# NOINLINE healthReportDuration #-}
healthReportDuration :: Vector Label2 Histogram
healthReportDuration = unsafeRegister . vector ("check", "status") $ histogram info buckets
  where
    info = Info "uni2work_health_check_duration_seconds"
                "Duration of last health check performed by this Uni2work-instance"
    buckets = histogramBuckets 5e-6 100e-3

data HealthCheckInterval = MkHealthCheckInterval

healthCheckInterval :: (HealthCheck -> Maybe NominalDiffTime) -> Metric HealthCheckInterval
healthCheckInterval hcInts = Metric $ return (MkHealthCheckInterval, collectHealthCheckInterval)
  where
    collectHealthCheckInterval = return . pure . SampleGroup info GaugeType $ do
      (hc, Just int) <- itoList hcInts
      return . Sample "uni2work_health_check_interval_seconds" [("check", toPathPiece hc)] . encodeUtf8 $ tshow (realToFrac int :: Nano)
    info = Info "uni2work_health_check_interval_seconds"
                "Target interval at which health checks are executed by this Uni2work-instance"

{-# NOINLINE httpRequestLatency #-}
httpRequestLatency :: Vector Label3 Histogram
httpRequestLatency = unsafeRegister . vector ("handler", "method", "status") $ histogram info buckets
  where info = Info "http_request_duration_seconds"
                    "HTTP request latency"
        buckets = histogramBuckets 50e-6 500

data ReadySince = MkReadySince

readyMetric :: POSIXTime -> Metric ReadySince
readyMetric ts = Metric $ return (MkReadySince, collectReadySince)
  where
    collectReadySince = return [SampleGroup info GaugeType [Sample "ready_time" [] sample]]
    info = Info "ready_time"
                "POSIXTime this Uni2work-instance became ready"
    sample = encodeUtf8 $ tshow (realToFrac ts :: Nano)

{-# NOINLINE jobWorkerStateDuration #-}
jobWorkerStateDuration :: Vector Label4 Histogram
jobWorkerStateDuration = unsafeRegister . vector ("worker", "state", "jobctl", "task") $ histogram info buckets
  where info = Info "uni2work_job_worker_state_duration_seconds"
                    "Duration of time a Uni2work job executor spent in a certain state"
        buckets = histogramBuckets 1e-6 5000

{-# NOINLINE jobWorkerStateTransitions #-}
jobWorkerStateTransitions :: Vector Label4 Counter
jobWorkerStateTransitions = unsafeRegister . vector ("worker", "state", "jobctl", "task") $ counter info
  where info = Info "uni2work_job_worker_state_transitions_total"
                    "Number of times a Uni2work job executor entered a certain state"

{-# NOINLINE yesodCacheSize #-}
yesodCacheSize :: Histogram
yesodCacheSize = unsafeRegister $ histogram info buckets
  where info = Info "yesod_ghs_cache_items"
                    "Number of items in Yesod's ghsCache and ghsCacheBy"
        buckets = 0 : histogramBuckets 1 1e6

{-# NOINLINE favouritesQuickActionsDuration #-}
favouritesQuickActionsDuration :: Histogram
favouritesQuickActionsDuration = unsafeRegister $ histogram info buckets
  where info = Info "uni2work_favourites_quick_actions_seconds"
                    "Duration of time needed to calculate a set of favourite quick actions"
        buckets = histogramBuckets 500e-6 50

{-# NOINLINE loginOutcomes #-}
loginOutcomes :: Vector Label2 Counter
loginOutcomes = unsafeRegister . vector ("plugin", "outcome") $ counter info
  where info = Info "uni2work_login_attempts_total"
                    "Number of login attempts"

data JobHeldLocksCount = MkJobHeldLocksCount

jobHeldLocksCount :: TVar (Set QueuedJobId) -> Metric JobHeldLocksCount
jobHeldLocksCount heldLocks = Metric $ return (MkJobHeldLocksCount, collectJobHeldLocksCount)
  where
    collectJobHeldLocksCount = do
      nLocks <- Set.size <$> readTVarIO heldLocks
      let sample = encodeUtf8 $ tshow nLocks
      return [SampleGroup info GaugeType [Sample "uni2work_jobs_held_locks_count" [] sample]]
    info = Info "uni2work_jobs_held_locks_count"
                "Number of job locks currently held by this Uni2work-instance"

{-# NOINLINE sourcedFileChunkSizes #-}
sourcedFileChunkSizes :: Vector Label1 Histogram
sourcedFileChunkSizes = unsafeRegister . vector "storage" $ histogram info buckets
  where info = Info "uni2work_sourced_file_chunks_bytes"
                    "Sizes of file chunks sourced"
        buckets = 0 : histogramBuckets 1 1000000000

{-# NOINLINE sunkFileChunkSizes #-}
sunkFileChunkSizes :: Vector Label1 Histogram
sunkFileChunkSizes = unsafeRegister . vector "storage" $ histogram info buckets
  where info = Info "uni2work_sunk_file_chunks_bytes"
                    "Sizes of file chunks sunk"
        buckets = 0 : histogramBuckets 1 1000000000

{-# NOINLINE deletedUnreferencedFiles #-}
deletedUnreferencedFiles :: Counter
deletedUnreferencedFiles = unsafeRegister $ counter info
  where info = Info "uni2work_deleted_unreferenced_files_count"
                    "Number of unreferenced files deleted"

{-# NOINLINE deletedUnreferencedChunks #-}
deletedUnreferencedChunks :: Counter
deletedUnreferencedChunks = unsafeRegister $ counter info
  where info = Info "uni2work_deleted_unreferenced_chunks_count"
                    "Number of unreferenced chunks deleted"

{-# NOINLINE deletedUnreferencedChunksBytes #-}
deletedUnreferencedChunksBytes :: Counter
deletedUnreferencedChunksBytes = unsafeRegister $ counter info
  where info = Info "uni2work_deleted_unreferenced_chunks_bytes"
                    "Size of unreferenced chunks deleted"

{-# NOINLINE injectedFiles #-}
injectedFiles :: Counter
injectedFiles = unsafeRegister $ counter info
  where info = Info "uni2work_injected_files_count"
                    "Number of files injected from upload cache into database"

{-# NOINLINE injectedFilesBytes #-}
injectedFilesBytes :: Counter
injectedFilesBytes = unsafeRegister $ counter info
  where info = Info "uni2work_injected_files_bytes"
                    "Size of files injected from upload cache into database"
  
{-# NOINLINE rechunkedFiles #-}
rechunkedFiles :: Counter
rechunkedFiles = unsafeRegister $ counter info
  where info = Info "uni2work_rechunked_files_count"
                    "Number of files rechunked within database"

{-# NOINLINE rechunkedFilesBytes #-}
rechunkedFilesBytes :: Counter
rechunkedFilesBytes = unsafeRegister $ counter info
  where info = Info "uni2work_rechunked_files_bytes"
                    "Size of files rechunked within database"

{-# NOINLINE databaseConnectionsOpened #-}
databaseConnectionsOpened :: Counter
databaseConnectionsOpened = unsafeRegister $ counter info
  where info = Info "uni2work_database_connections_opened"
                    "Number of new connections to database opened"

{-# NOINLINE databaseConnectionsClosed #-}
databaseConnectionsClosed :: Counter
databaseConnectionsClosed = unsafeRegister $ counter info
  where info = Info "uni2work_database_connections_closed"
                    "Number of connections to database closed"

data JobWorkerQueueDepth = MkJobWorkerQueueDepth

jobWorkerQueueDepth :: TMVar JobState -> Metric JobWorkerQueueDepth
jobWorkerQueueDepth jSt = Metric $ return (MkJobWorkerQueueDepth, collectJobWorkerQueueDepth)
  where
    collectJobWorkerQueueDepth = maybeT (return []) $ do
      wQueues <- hoist atomically $ do
        JobState{..} <- MaybeT $ tryReadTMVar jSt
        flip ifoldMapM jobWorkers $ \wAsync wQueue
          -> lift $ pure . (jobWorkerName wAsync, ) . jqDepth <$> readTVar wQueue
      return [ SampleGroup info GaugeType
                 [ Sample "uni2work_queued_jobs_count" [("worker", showWorkerId wName)] . encodeUtf8 $ tshow wDepth
                 | (wName, wDepth) <- wQueues
                 ]
             ]
    info = Info "uni2work_queued_jobs_count"
                "Number of JobQueue entries in this Uni2work-instance"

{-# NOINLINE missingFiles #-}
missingFiles :: Vector Label1 Gauge
missingFiles = unsafeRegister . vector "ref" $ gauge info
  where info = Info "uni2work_missing_files_count"
                    "Number of files referenced from within database that are missing"

{-# NOINLINE favouritesSkippedDueToDBLoad #-}
favouritesSkippedDueToDBLoad :: Counter
favouritesSkippedDueToDBLoad = unsafeRegister $ counter info
  where info = Info "uni2work_favourites_skipped_due_to_db_load_count"
                    "Number of times this Uni2work-instance skipped generating FavouriteQuickActions due to database pressure"
  
relabel :: Text -> Text
        -> SampleGroup -> SampleGroup
relabel l s (SampleGroup i t ss) = SampleGroup i t . flip map ss $ \(Sample k lbls v) -> Sample k ((l, s) : filter (views _1 $ (/=) l) lbls) v

data ARCMetrics = ARCMetrics

data ARCLabel = ARCFileSource | ARCMemcachedLocal
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''ARCLabel $ camelToPathPiece' 1

arcMetrics :: Integral w
           => ARCLabel
           -> ARCHandle k w v
           -> Metric ARCMetrics
arcMetrics lbl ah = Metric $ return (ARCMetrics, collectARCMetrics)
  where
    labelArc = relabel "arc"

    collectARCMetrics = map (labelArc $ toPathPiece lbl) <$> do
      (arc, _) <- readARCHandle ah
      return
        [ SampleGroup sizeInfo GaugeType
          [ Sample "arc_size" [("lru", "ghost-recent")] . encodeUtf8 . tshow $ arcGhostRecentSize arc
          , Sample "arc_size" [("lru", "recent")] . encodeUtf8 . tshow $ arcRecentSize arc
          , Sample "arc_size" [("lru", "frequent")] . encodeUtf8 . tshow $ arcFrequentSize arc
          , Sample "arc_size" [("lru", "ghost-frequent")] . encodeUtf8 . tshow $ arcGhostFrequentSize arc
          ]
        , SampleGroup weightInfo GaugeType
          [ Sample "arc_weight" [("lru", "recent")] . encodeUtf8 . tshow . toInteger $ getARCRecentWeight arc
          , Sample "arc_weight" [("lru", "frequent")] . encodeUtf8 . tshow . toInteger $ getARCFrequentWeight arc
          ]
        ]
    sizeInfo = Info "arc_size"
                    "Number of entries in the ARC LRUs"
    weightInfo = Info "arc_weight"
                      "Sum of weights of entries in the ARC LRUs"

data LRUMetrics = LRUMetrics

data LRULabel = LRUFileSourcePrewarm
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''LRULabel $ camelToPathPiece' 1

lruMetrics :: Integral w
           => LRULabel
           -> LRUHandle k t w v
           -> Metric LRUMetrics
lruMetrics lbl lh = Metric $ return (LRUMetrics, collectLRUMetrics)
  where
    labelLru = relabel "lru"

    collectLRUMetrics = map (labelLru $ toPathPiece lbl) <$> do
      (lru, _) <- readLRUHandle lh
      return
        [ SampleGroup sizeInfo GaugeType
            [ Sample "lru_size" [] . encodeUtf8 . tshow $ lruStoreSize lru
            ]
        , SampleGroup weightInfo GaugeType
            [ Sample "lru_weight" [] . encodeUtf8 . tshow . toInteger $ getLRUWeight lru
            ]
        ]
    sizeInfo = Info "lru_size"
                    "Number of entries in the LRU"
    weightInfo = Info "lru_weight"
                      "Sum of weights of entries in the LRU"

data InjectInhibitMetrics = InjectInhibitMetrics

injectInhibitMetrics :: TVar (IntervalMap UTCTime (Set FileContentReference))
                     -> Metric InjectInhibitMetrics
injectInhibitMetrics tvar = Metric $ return (InjectInhibitMetrics, collectInjectInhibitMetrics)
  where
    collectInjectInhibitMetrics = do
      inhibits <- readTVarIO tvar
      return
        [ SampleGroup intervalsInfo GaugeType
          [ Sample "uni2work_inject_inhibited_intervals_count" [] . encodeUtf8 . tshow $ IntervalMap.size inhibits
          ]
        , SampleGroup hashesInfo GaugeType
          [ Sample "uni2work_inject_inhibited_hashes_count" [] . encodeUtf8 . tshow . Set.size $ F.fold inhibits
          ]
        ]
    intervalsInfo = Info "uni2work_inject_inhibited_intervals_count" 
                         "Number of distinct time intervals in which we don't transfer some files from upload cache to db"
    hashesInfo = Info "uni2work_inject_inhibited_hashes_count" 
                      "Number of files which we don't transfer from upload cache to db during some interval"

data PoolMetrics = PoolMetrics

data PoolLabel = PoolDatabaseConnections
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''PoolLabel $ camelToPathPiece' 1

poolMetrics :: PoolLabel
            -> Custom.Pool' m c' c a
            -> Metric PoolMetrics
poolMetrics lbl pool = Metric $ return (PoolMetrics, collectPoolMetrics)
  where
    labelPool = relabel "pool" $ toPathPiece lbl

    collectPoolMetrics = map labelPool <$> do
      (available, inUse, usesCount) <- atomically $ (,,)
        <$> Custom.getPoolAvailableCount pool
        <*> Custom.getPoolInUseCount pool
        <*> Custom.getPoolUsesCount pool
      return
        [ SampleGroup availableInfo GaugeType
          [ Sample "uni2work_pool_available_count" [] . encodeUtf8 $ tshow available
          ]
        , SampleGroup inUseInfo GaugeType
          [ Sample "uni2work_pool_in_use_count" [] . encodeUtf8 $ tshow inUse
          ]
        , SampleGroup usesInfo CounterType
          [ Sample "uni2work_pool_uses_count" [] . encodeUtf8 $ tshow usesCount
          ]
        ]
  
    availableInfo = Info "uni2work_pool_available_count" 
                         "Number of open resources available for taking"
    inUseInfo = Info "uni2work_pool_in_use_count" 
                     "Number of resources currently in use"
    usesInfo = Info "uni2work_pool_uses_count" 
                    "Number of takes executed against the pool"

{-# NOINLINE databaseConnDuration #-}
databaseConnDuration :: Vector Label1 Histogram
databaseConnDuration = unsafeRegister . vector "label" $ histogram info buckets
  where
    info = Info "uni2work_database_conn_duration_seconds"
                "Duration of use of a database connection from the pool"
    buckets = histogramBuckets 50e-6 5000
  
data DBConnUseState = DBConnUseState
  { dbConnUseStart :: !TimeSpec
  , dbConnUseLabel :: !CallStack
  } deriving (Show)

onUseDBConn :: (MonadIO m, MonadLogger m) => CallStack -> a -> m DBConnUseState
onUseDBConn dbConnUseLabel _ = do
  $logDebugS "DB" $ case getCallStack dbConnUseLabel of
    [] -> "no stack"
    xs -> intercalate "; " $ map (\(f, loc) -> pack f <> " @(" <> pack (prettySrcLoc loc) <> ")") xs
  dbConnUseStart <- liftIO $ getTime Monotonic
  return DBConnUseState{..}

onReleaseDBConn :: MonadIO m => DBConnUseState -> a -> m ()
onReleaseDBConn DBConnUseState{..} _ = liftIO $ do
  diff <- realToFrac . subtract dbConnUseStart <$> getTime Monotonic
  let lbl = case reverse $ getCallStack dbConnUseLabel of
        [] -> "unlabeled"
        (_, SrcLoc{..}) : _ -> pack srcLocModule
  withLabel databaseConnDuration lbl $ flip observe diff

data AuthTagEvalOutcome = OutcomeAuthorized | OutcomeUnauthorized | OutcomeAuthenticationRequired | OutcomeException
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving (Universe, Finite)
nullaryPathPiece ''AuthTagEvalOutcome $ camelToPathPiece' 1

{-# NOINLINE authTagEvaluationDuration #-}
authTagEvaluationDuration :: Vector Label3 Histogram
authTagEvaluationDuration = unsafeRegister . vector ("tag", "outcome", "handler") $ histogram info buckets
  where
    info = Info "uni2work_auth_tag_evaluation_duration_seconds"
                "Duration of auth tag evaluations"
    buckets = histogramBuckets 5e-6 1
    

withHealthReportMetrics :: MonadIO m => m HealthReport -> m HealthReport
withHealthReportMetrics act = do
  before <- liftIO getPOSIXTime
  report <- act
  after <- liftIO getPOSIXTime

  let checkVal = toPathPiece $ classifyHealthReport report
      statusVal = toPathPiece $ healthReportStatus report
      timeSample, durationSample :: Double
      timeSample = realToFrac (realToFrac after :: Nano)
      durationSample = realToFrac (realToFrac $ after - before :: Nano)
  liftIO $ withLabel healthReportTime (checkVal, statusVal) $ flip setGauge timeSample
  liftIO $ withLabel healthReportDuration (checkVal, statusVal) $ flip observe durationSample

  return report

registerGHCMetrics :: MonadIO m => m ()
registerGHCMetrics = void $ register ghcMetrics

observeHTTPRequestLatency :: forall site. ParseRoute site => (Route site -> String) -> Middleware
observeHTTPRequestLatency classifyHandler app req respond' = do
  start <- getTime Monotonic
  app req $ \res -> do
    end <- getTime Monotonic
    let method  = decodeUtf8 $ Wai.requestMethod req
        status  = tshow . HTTP.statusCode $ Wai.responseStatus res
        route :: Maybe (Route site)
        route   = parseRoute ( Wai.pathInfo req
                             , over (mapped . _2) (fromMaybe "") . HTTP.queryToQueryText $ Wai.queryString req
                             )
        handler' = pack . classifyHandler <$> route

        labels :: Label3
        labels = (fromMaybe "n/a" handler', method, status)
    withLabel httpRequestLatency labels . flip observe . realToFrac $ end - start

    respond' res

registerReadyMetric :: MonadIO m => m ()
registerReadyMetric = liftIO $ void . register . readyMetric =<< getPOSIXTime

registerHealthCheckInterval :: MonadIO m => (HealthCheck -> Maybe NominalDiffTime) -> m ()
registerHealthCheckInterval = liftIO . void . register . healthCheckInterval

classifyJobWorkerState :: JobWorkerId -> JobWorkerState -> Prometheus.Label4
classifyJobWorkerState wId jws = (showWorkerId wId, tag, maybe "n/a" pack mJobCtl, maybe "n/a" pack mJob)
  where
    Aeson.Object obj = Aeson.toJSON jws
    Aeson.String tag = obj HashMap.! "state"
    mJobCtl = asum
      [ classifyJobCtl <$> jws ^? _jobWorkerJobCtl
      , "perform" <$ jws ^? _jobWorkerJob
      ]
    mJob = classifyJob <$> jws ^? _jobWorkerJob

withJobWorkerState :: (MonadIO m, MonadMask m) => JobWorkerId -> JobWorkerState -> m a -> m a
withJobWorkerState wId newSt = withJobWorkerStateLbls $ classifyJobWorkerState wId newSt

withJobWorkerStateLbls :: (MonadIO m, MonadMask m) => Label4 -> m a -> m a
withJobWorkerStateLbls newLbls act = do
  liftIO $ withLabel jobWorkerStateTransitions newLbls incCounter

  start <- liftIO $ getTime Monotonic
  res <- handleAll (return . Left) $ Right <$> act
  end <- liftIO $ getTime Monotonic

  liftIO . withLabel jobWorkerStateDuration newLbls . flip observe . realToFrac $ end - start

  throwLeft res

observeYesodCacheSize :: MonadHandler m => m ()
observeYesodCacheSize = do
  HandlerData{handlerState} <- liftHandler ask
  liftIO $ do
    GHState{..} <- readIORef handlerState
    let size = fromIntegral $ length ghsCache + length ghsCacheBy
    observe yesodCacheSize size

observeFavouritesQuickActionsDuration :: (MonadIO m, MonadMask m) => m a -> m a
observeFavouritesQuickActionsDuration act = do
  start <- liftIO $ getTime Monotonic
  res <- handleAll (return . Left) $ Right <$> act
  end <- liftIO $ getTime Monotonic

  liftIO . observe favouritesQuickActionsDuration . realToFrac $ end - start

  throwLeft res

data LoginOutcome
  = LoginSuccessful
  | LoginInvalidCredentials
  | LoginADInvalidCredentials
  | LoginError
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)
nullaryPathPiece ''LoginOutcome $ camelToPathPiece' 1

observeLoginOutcome :: MonadHandler m
                    => Text -- ^ Plugin
                    -> LoginOutcome
                    -> m ()
observeLoginOutcome plugin outcome
  = liftIO $ withLabel loginOutcomes (plugin, toPathPiece outcome) incCounter

registerJobHeldLocksCount :: MonadIO m => TVar (Set QueuedJobId) -> m ()
registerJobHeldLocksCount = liftIO . void . register . jobHeldLocksCount

data FileChunkStorage = StorageMinio | StorageDB | StorageARC | StoragePrewarm
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite)
nullaryPathPiece ''FileChunkStorage $ camelToPathPiece' 1

observeSunkChunk, observeSourcedChunk :: (Integral n, MonadIO m) => FileChunkStorage -> n -> m ()
observeSunkChunk store = liftIO . observeChunkSize sunkFileChunkSizes store . fromIntegral
observeSourcedChunk store = liftIO . observeChunkSize sourcedFileChunkSizes store . fromIntegral

observeChunkSize :: Vector Label1 Histogram -> FileChunkStorage -> Integer -> IO ()
observeChunkSize metric (toPathPiece -> storageLabel) = withLabel metric storageLabel . flip observe . fromInteger

observeDeletedUnreferencedFiles :: MonadIO m => Natural -> m ()
observeDeletedUnreferencedFiles = liftIO . void . addCounter deletedUnreferencedFiles . fromIntegral

observeDeletedUnreferencedChunks :: MonadIO m => Natural -> Word64 -> m ()
observeDeletedUnreferencedChunks num size = liftIO $ do
  void . addCounter deletedUnreferencedChunks $ fromIntegral num
  void . addCounter deletedUnreferencedChunksBytes $ fromIntegral size

observeInjectedFiles :: MonadIO m => Natural -> Word64 -> m ()
observeInjectedFiles num size = liftIO $ do
  void . addCounter injectedFiles $ fromIntegral num
  void . addCounter injectedFilesBytes $ fromIntegral size

observeRechunkedFiles :: MonadIO m => Natural -> Word64 -> m ()
observeRechunkedFiles num size = liftIO $ do
  void . addCounter rechunkedFiles $ fromIntegral num
  void . addCounter rechunkedFilesBytes $ fromIntegral size

registerJobWorkerQueueDepth :: MonadIO m => TMVar JobState -> m ()
registerJobWorkerQueueDepth = liftIO . void . register . jobWorkerQueueDepth

observeMissingFiles :: MonadIO m => Text -> Int -> m ()
observeMissingFiles refIdent = liftIO . withLabel missingFiles refIdent . flip setGauge . fromIntegral

observeDatabaseConnectionOpened, observeDatabaseConnectionClosed :: MonadIO m => m ()
observeDatabaseConnectionOpened = liftIO $ incCounter databaseConnectionsOpened
observeDatabaseConnectionClosed = liftIO $ incCounter databaseConnectionsClosed

observeAuthTagEvaluation :: MonadUnliftIO m => AuthTag -> String -> m (a, AuthTagEvalOutcome) -> m a
observeAuthTagEvaluation aTag handler act = do
  start <- liftIO $ getTime Monotonic
  res <- tryAny act
  end <- liftIO $ getTime Monotonic

  let outcome = case res of
        Right (_, outcome') -> outcome'
        Left _ -> OutcomeException
  
  liftIO . withLabel authTagEvaluationDuration (toPathPiece aTag, toPathPiece outcome, pack handler) . flip observe . realToFrac $ end - start

  either throwIO (views _1 return) res

observeFavouritesSkippedDueToDBLoad :: MonadIO m => m ()
observeFavouritesSkippedDueToDBLoad = liftIO $ incCounter favouritesSkippedDueToDBLoad