graphql-engine/server/src-lib/Hasura/RQL/DDL/ScheduledTrigger.hs
2021-09-13 18:01:55 +00:00

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
]