module Prod.Watchdog where import Control.Exception.Base (IOException, catch) import Control.Monad (when) import Data.Text (Text) import qualified Data.Text as Text import Data.Time.Clock (UTCTime, getCurrentTime) import Prod.Background (BackgroundVal, MicroSeconds, backgroundLoop) import qualified Prod.Background import Prod.Tracer (Tracer (..), contramap) import Prometheus (Counter, Label1, Label2, Vector) import qualified Prometheus as Prometheus import System.Directory (doesFileExist, setModificationTime) data Track r = BackgroundTrack (Prod.Background.Track (WatchdogResult r)) deriving (Show) data WatchdogResult a = Skipped | Success a | Failed deriving (Show, Ord, Eq) data Watchdog a = Watchdog { backgroundVal :: BackgroundVal (WatchdogResult a) , tracer :: Tracer IO (Track a) } watchdog :: (Prometheus.Label label) => Vector label Counter -> Tracer IO (Track a) -> (WatchdogResult a -> label) -> MicroSeconds Int -> IO (WatchdogResult a) -> IO (Watchdog a) watchdog counters tracer mkLabel delay action = Watchdog <$> backgroundLoop (contramap BackgroundTrack tracer) Skipped go delay <*> pure tracer where go = do res <- action Prometheus.withLabel counters (mkLabel res) Prometheus.incCounter pure res {- | Basic watchdog with a vector metric. The input vector label is set with success|failed|skipped depending on the WatchdogResult. -} basicWatchdog :: Vector Label1 Counter -> Tracer IO (Track a) -> MicroSeconds Int -> IO (WatchdogResult a) -> IO (Watchdog a) basicWatchdog counters tracer delay action = watchdog counters tracer basicLabel delay action basicLabel :: WatchdogResult a -> Label1 basicLabel res = case res of Success _ -> "success" Failed -> "failed" Skipped -> "skipped" data FileTouchTrack r = FileTouchTrack FilePath (Track r) deriving (Show) {- | Touches a file periodically, using setModificationTime. If the file does not exists when the watchdog is initialized, then it is created empty. -} fileTouchWatchdog :: FilePath -> Tracer IO (FileTouchTrack UTCTime) -> MicroSeconds Int -> IO (Watchdog UTCTime) fileTouchWatchdog path tracer delay = do let mkLabel res = (basicLabel res, Text.pack path) shouldCreate <- not <$> doesFileExist path when shouldCreate $ writeFile path "" watchdog fileTouchWatchdogCounter (contramap (FileTouchTrack path) tracer) mkLabel delay io where handleIOException :: IOException -> IO (WatchdogResult UTCTime) handleIOException _ = pure $ Failed io = do now <- getCurrentTime let touchFile = setModificationTime path now *> pure (Success now) touchFile `catch` handleIOException {-# NOINLINE fileTouchWatchdogCounter #-} fileTouchWatchdogCounter :: Vector Label2 Counter fileTouchWatchdogCounter = Prometheus.unsafeRegister $ Prometheus.vector ("status", "path") $ Prometheus.counter (Prometheus.Info "prodapi_watchdog_filetouch" "")