module Hasura.RQL.DDL.ScheduledTrigger ( runCreateCronTrigger, runDeleteCronTrigger, dropCronTriggerInMetadata, resolveCronTrigger, runCreateScheduledEvent, runDeleteScheduledEvent, runGetScheduledEvents, runGetEventInvocations, populateInitialCronTriggerEvents, ) where import Data.Aeson qualified as J import Data.Environment qualified as Env import Data.HashMap.Strict qualified as Map import Data.HashMap.Strict.InsOrd qualified as OMap import Data.Time.Clock qualified as C import Hasura.Base.Error import Hasura.EncJSON import Hasura.Eventing.ScheduledTrigger import Hasura.Metadata.Class import Hasura.Prelude import Hasura.RQL.DDL.EventTrigger (getHeaderInfosFromConf) import Hasura.RQL.Types import System.Cron.Types (CronSchedule) populateInitialCronTriggerEvents :: ( MonadIO m, MonadMetadataStorageQueryAPI m ) => CronSchedule -> TriggerName -> m () populateInitialCronTriggerEvents schedule triggerName = do currentTime <- liftIO C.getCurrentTime let scheduleTimes = generateScheduleTimes currentTime 100 schedule insertCronEvents $ map (CronEventSeed triggerName) scheduleTimes pure () -- | runCreateCronTrigger will update a existing cron trigger when the 'replace' -- value is set to @true@ and when replace is @false@ a new cron trigger will -- be created runCreateCronTrigger :: ( CacheRWM m, MonadIO m, MetadataM m, MonadMetadataStorageQueryAPI m ) => CreateCronTrigger -> m EncJSON runCreateCronTrigger CreateCronTrigger {..} = do let q = CronTriggerMetadata cctName cctWebhook cctCronSchedule cctPayload cctRetryConf cctHeaders cctIncludeInMetadata cctComment case cctReplace of True -> updateCronTrigger q False -> do cronTriggersMap <- scCronTriggers <$> askSchemaCache case Map.lookup (ctName q) cronTriggersMap of Nothing -> pure () Just _ -> throw400 AlreadyExists $ "cron trigger with name: " <> triggerNameToTxt (ctName q) <> " already exists" let metadataObj = MOCronTrigger cctName metadata = CronTriggerMetadata cctName cctWebhook cctCronSchedule cctPayload cctRetryConf cctHeaders cctIncludeInMetadata cctComment buildSchemaCacheFor metadataObj $ MetadataModifier $ metaCronTriggers %~ OMap.insert cctName metadata populateInitialCronTriggerEvents cctCronSchedule cctName return successMsg resolveCronTrigger :: (QErrM m) => Env.Environment -> CronTriggerMetadata -> m CronTriggerInfo resolveCronTrigger env CronTriggerMetadata {..} = do webhookInfo <- resolveWebhook env ctWebhook headerInfo <- getHeaderInfosFromConf env ctHeaders pure $ CronTriggerInfo ctName ctSchedule ctPayload ctRetryConf webhookInfo headerInfo ctComment updateCronTrigger :: ( CacheRWM m, MonadIO m, MetadataM m, MonadMetadataStorageQueryAPI m ) => CronTriggerMetadata -> m EncJSON updateCronTrigger cronTriggerMetadata = do let triggerName = ctName cronTriggerMetadata checkExists triggerName buildSchemaCacheFor (MOCronTrigger triggerName) $ MetadataModifier $ metaCronTriggers %~ OMap.insert triggerName cronTriggerMetadata dropFutureCronEvents $ SingleCronTrigger triggerName currentTime <- liftIO C.getCurrentTime let scheduleTimes = generateScheduleTimes currentTime 100 $ ctSchedule cronTriggerMetadata insertCronEvents $ map (CronEventSeed triggerName) scheduleTimes pure successMsg runDeleteCronTrigger :: ( CacheRWM m, MetadataM m, MonadMetadataStorageQueryAPI m ) => ScheduledTriggerName -> m EncJSON runDeleteCronTrigger (ScheduledTriggerName stName) = do checkExists stName withNewInconsistentObjsCheck $ buildSchemaCache $ dropCronTriggerInMetadata stName dropFutureCronEvents $ SingleCronTrigger stName return successMsg dropCronTriggerInMetadata :: TriggerName -> MetadataModifier dropCronTriggerInMetadata name = MetadataModifier $ metaCronTriggers %~ OMap.delete name runCreateScheduledEvent :: (MonadMetadataStorageQueryAPI m) => CreateScheduledEvent -> m EncJSON runCreateScheduledEvent scheduledEvent = do eid <- createOneOffScheduledEvent scheduledEvent pure $ encJFromJValue $ J.object ["message" J..= J.String "success", "event_id" J..= eid] checkExists :: (CacheRM m, MonadError QErr m) => TriggerName -> m () checkExists name = do cronTriggersMap <- scCronTriggers <$> askSchemaCache void $ onNothing (Map.lookup name cronTriggersMap) $ throw400 NotExists $ "cron trigger with name: " <> triggerNameToTxt name <> " does not exist" runDeleteScheduledEvent :: (MonadMetadataStorageQueryAPI m) => DeleteScheduledEvent -> m EncJSON runDeleteScheduledEvent DeleteScheduledEvent {..} = do dropEvent _dseEventId _dseType pure successMsg runGetScheduledEvents :: ( CacheRM m, MonadMetadataStorageQueryAPI m ) => GetScheduledEvents -> m EncJSON runGetScheduledEvents gse = do case _gseScheduledEvent gse of SEOneOff -> pure () SECron name -> checkExists name encJFromJValue <$> fetchScheduledEvents gse runGetEventInvocations :: ( CacheRM m, MonadMetadataStorageQueryAPI m ) => GetEventInvocations -> m EncJSON runGetEventInvocations GetEventInvocations {..} = do case _geiInvocationsBy of GIBEventId _ _ -> pure () GIBEvent event -> case event of SEOneOff -> pure () SECron name -> checkExists name WithTotalCount count invocations <- fetchInvocations _geiInvocationsBy _geiPagination pure $ encJFromJValue $ J.object [ "invocations" J..= invocations, "count" J..= count ]