NotificationRetryWorker.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Utils.Vigilance.Workers.NotificationRetryWorker ( runWorker
                                                       , failuresToRetry
                                                       , notifyOrBump
                                                       , renderFail ) where

import ClassyPrelude
import Control.Lens
import Data.Acid (AcidState)
import Text.InterpolatedString.Perl6 (qc)
import Utils.Vigilance.Logger ( pushLog
                              , renameLogCtx
                              , vLog )
import Utils.Vigilance.TableOps
import Utils.Vigilance.Types

-- | Intended to be exclusive
runWorker :: AcidState AppState -> Int -> NotifierGroup -> LogCtxT IO ()
runWorker acid maxRetries notifiers = renameLogCtx "Notification Retry Worker" $ do
  fails  <- lift $ allFailedNotificationsS acid
  unless (null fails) $ vLog [qc|Retrying failed notifications for {startLog fails}|]
  fails' <- catMaybes <$> mapM (notify notifiers) fails
  mapM_ logFail fails'
  let toRetry = failuresToRetry maxRetries fails'
  lift $ setFailedNotificationsS acid toRetry
  where startLog fails = intercalate ", " $ map (\w -> w ^. failedWatch . watchName . unWatchName) fails

notifyOrBump :: Notifier -> FailedNotification -> LogCtxT IO (Maybe FailedNotification)
notifyOrBump n fn = do
  vLog logMsg
  fn' <- listToMaybe <$> n [watch]
  maybe retrySuccessful retryFailed fn'
  where retrySuccessful = return Nothing
        retryFailed fn' = return . Just $ fn' & retries .~ (fn ^. retries + 1)
        watch           = fn ^. failedWatch
        wn              = watch ^. watchName . unWatchName
        logMsg = [qc|Retrying notification {fn ^. failedPref} for {wn} after {fn ^. retries} retries|]

notify :: NotifierGroup -> FailedNotification -> LogCtxT IO (Maybe FailedNotification)
notify NotifierGroup { _ngEmail = Just n}
       fn@FailedNotification { _failedPref = (EmailNotification _)} = notifyOrBump (n ^. notifier) fn
notify NotifierGroup {_ngHTTP}
       fn@FailedNotification { _failedPref = (HTTPNotification _)} = notifyOrBump (_ngHTTP ^. notifier) fn
notify _ fn = pushLog [qc|No notifier configured for {fn}|] >> return Nothing

logFail :: FailedNotification -> LogCtxT IO ()
logFail = pushLog . renderFail

renderFail :: FailedNotification -> Text
renderFail FailedNotification {..} = [qc|Watch {wn} failed to notify after {_retries} retries on {pref}: {_failedLastError}|]
  where wn = _failedWatch ^. watchName . unWatchName
        pref = renderPref _failedPref

renderPref :: NotificationPreference -> Text
renderPref (EmailNotification (EmailAddress a)) = [qc|EmailNotification {a}|]
renderPref (HTTPNotification u)                 = [qc|HTTPNotification {u}|]

failuresToRetry :: Int -> [FailedNotification] -> [FailedNotification]
failuresToRetry maxRetries = filter underLimit
  where underLimit fn = fn ^. retries < maxRetries