mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
bafefac73d
https://github.com/hasura/graphql-engine-mono/pull/2313 GitOrigin-RevId: a72880734074105d55bb387fdb5d1a9f5fac1d72
181 lines
6.2 KiB
Haskell
181 lines
6.2 KiB
Haskell
module Hasura.RQL.DDL.ScheduledTrigger
|
|
( runCreateCronTrigger
|
|
, runDeleteCronTrigger
|
|
, dropCronTriggerInMetadata
|
|
, resolveCronTrigger
|
|
, runCreateScheduledEvent
|
|
, runDeleteScheduledEvent
|
|
, runGetScheduledEvents
|
|
, runGetEventInvocations
|
|
, populateInitialCronTriggerEvents
|
|
) where
|
|
|
|
import System.Cron.Types (CronSchedule)
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Environment as Env
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.HashMap.Strict.InsOrd as OMap
|
|
import qualified Data.Time.Clock as C
|
|
|
|
import Hasura.Base.Error
|
|
import Hasura.EncJSON
|
|
import Hasura.Eventing.ScheduledTrigger
|
|
import Hasura.Metadata.Class
|
|
import Hasura.RQL.DDL.EventTrigger (getHeaderInfosFromConf)
|
|
import Hasura.RQL.Types
|
|
|
|
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
|
|
]
|