Observability.hs

module Tricorder.Observability
    ( Config (..)
    , MetricsConfig (..)
    , component
    ) where

import Atelier.Component (Component (..), Trigger, defaultComponent)
import Atelier.Effects.Delay (Delay)
import Atelier.Effects.Log (Log)
import Atelier.Effects.Monitoring.Metrics.Server (MetricsServer)
import Atelier.Effects.Monitoring.Tracing (TracingConfig)
import Atelier.Time (Millisecond)
import Atelier.Types.QuietSnake (QuietSnake (..))
import Atelier.Types.WithDefaults (WithDefaults (..))
import Data.Aeson (FromJSON, ToJSON)
import Data.Default (Default (..))
import Effectful.Exception (trySync)
import Effectful.Reader.Static (Reader, ask)

import Atelier.Effects.Delay qualified as Delay
import Atelier.Effects.Log qualified as Log
import Atelier.Effects.Monitoring.Metrics.Server qualified as MetricsServer


data MetricsConfig = MetricsConfig
    { enabled :: Bool
    , port :: Int
    }
    deriving stock (Eq, Generic, Show)
    deriving (ToJSON) via QuietSnake MetricsConfig
    deriving (FromJSON) via WithDefaults (QuietSnake MetricsConfig)


instance Default MetricsConfig where
    def = MetricsConfig {enabled = False, port = 9091}


data Config = Config
    { metrics :: MetricsConfig
    , tracing :: TracingConfig
    }
    deriving stock (Eq, Generic, Show)
    deriving (FromJSON) via QuietSnake Config


instance Default Config where
    def = Config {metrics = def, tracing = def}


component :: (Delay :> es, Log :> es, MetricsServer :> es, Reader Config :> es) => Component es
component =
    defaultComponent
        { name = "Observability"
        , triggers = do
            cfg <- ask @Config
            pure
                $ if cfg.metrics.enabled then
                    [metricsServerTrigger cfg.metrics.port]
                else
                    []
        }


metricsServerTrigger :: (Delay :> es, Log :> es, MetricsServer :> es) => Int -> Trigger es
metricsServerTrigger port = do
    result <- trySync $ MetricsServer.runMetricsServer port
    case result of
        Right () -> pure ()
        Left e ->
            Log.warn $ "Metrics server on port " <> show port <> " failed to start: " <> show e
    forever $ Delay.wait (3_600_000 :: Millisecond)