module Hasura.RQL.DDL.ScheduledTrigger
  ( runCreateCronTrigger,
    runDeleteCronTrigger,
    dropCronTriggerInMetadata,
    resolveCronTrigger,
    runCreateScheduledEvent,
    runDeleteScheduledEvent,
    runGetScheduledEvents,
    runGetScheduledEventInvocations,
    populateInitialCronTriggerEvents,
    runGetCronTriggers,
  )
where

import Data.Aeson qualified as J
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Time.Clock qualified as C
import Data.URL.Template (printTemplate)
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.Common
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import System.Cron.Types (CronSchedule)

populateInitialCronTriggerEvents ::
  ( MonadIO m,
    MonadError QErr m,
    MonadMetadataStorage m
  ) =>
  CronSchedule ->
  TriggerName ->
  m ()
populateInitialCronTriggerEvents :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadMetadataStorage m) =>
CronSchedule -> TriggerName -> m ()
populateInitialCronTriggerEvents CronSchedule
schedule TriggerName
triggerName = do
  UTCTime
currentTime <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
C.getCurrentTime
  let scheduleTimes :: [UTCTime]
scheduleTimes = UTCTime -> Int -> CronSchedule -> [UTCTime]
generateScheduleTimes UTCTime
currentTime Int
100 CronSchedule
schedule
  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ [CronEventSeed] -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> m (Either QErr ())
insertCronEvents ([CronEventSeed] -> m (Either QErr ()))
-> [CronEventSeed] -> m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ (UTCTime -> CronEventSeed) -> [UTCTime] -> [CronEventSeed]
forall a b. (a -> b) -> [a] -> [b]
map (TriggerName -> UTCTime -> CronEventSeed
CronEventSeed TriggerName
triggerName) [UTCTime]
scheduleTimes

-- | 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 ::
  ( MonadError QErr m,
    CacheRWM m,
    MonadIO m,
    MetadataM m,
    MonadMetadataStorage m
  ) =>
  CreateCronTrigger ->
  m EncJSON
runCreateCronTrigger :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MonadIO m, MetadataM m,
 MonadMetadataStorage m) =>
CreateCronTrigger -> m EncJSON
runCreateCronTrigger CreateCronTrigger {Bool
[HeaderConf]
Maybe Text
Maybe Value
Maybe RequestTransform
Maybe MetadataResponseTransform
CronSchedule
InputWebhook
TriggerName
STRetryConf
_cctName :: TriggerName
_cctWebhook :: InputWebhook
_cctCronSchedule :: CronSchedule
_cctPayload :: Maybe Value
_cctRetryConf :: STRetryConf
_cctHeaders :: [HeaderConf]
_cctIncludeInMetadata :: Bool
_cctComment :: Maybe Text
_cctReplace :: Bool
_cctRequestTransform :: Maybe RequestTransform
_cctResponseTransform :: Maybe MetadataResponseTransform
_cctName :: CreateCronTrigger -> TriggerName
_cctWebhook :: CreateCronTrigger -> InputWebhook
_cctCronSchedule :: CreateCronTrigger -> CronSchedule
_cctPayload :: CreateCronTrigger -> Maybe Value
_cctRetryConf :: CreateCronTrigger -> STRetryConf
_cctHeaders :: CreateCronTrigger -> [HeaderConf]
_cctIncludeInMetadata :: CreateCronTrigger -> Bool
_cctComment :: CreateCronTrigger -> Maybe Text
_cctReplace :: CreateCronTrigger -> Bool
_cctRequestTransform :: CreateCronTrigger -> Maybe RequestTransform
_cctResponseTransform :: CreateCronTrigger -> Maybe MetadataResponseTransform
..} = do
  let q :: CronTriggerMetadata
q =
        TriggerName
-> InputWebhook
-> CronSchedule
-> Maybe Value
-> STRetryConf
-> [HeaderConf]
-> Bool
-> Maybe Text
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> CronTriggerMetadata
CronTriggerMetadata
          TriggerName
_cctName
          InputWebhook
_cctWebhook
          CronSchedule
_cctCronSchedule
          Maybe Value
_cctPayload
          STRetryConf
_cctRetryConf
          [HeaderConf]
_cctHeaders
          Bool
_cctIncludeInMetadata
          Maybe Text
_cctComment
          Maybe RequestTransform
_cctRequestTransform
          Maybe MetadataResponseTransform
_cctResponseTransform
  case Bool
_cctReplace of
    Bool
True -> CronTriggerMetadata -> m EncJSON
forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MonadIO m, MetadataM m,
 MonadMetadataStorage m) =>
CronTriggerMetadata -> m EncJSON
updateCronTrigger CronTriggerMetadata
q
    Bool
False -> do
      HashMap TriggerName CronTriggerInfo
cronTriggersMap <- SchemaCache -> HashMap TriggerName CronTriggerInfo
scCronTriggers (SchemaCache -> HashMap TriggerName CronTriggerInfo)
-> m SchemaCache -> m (HashMap TriggerName CronTriggerInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
      case TriggerName
-> HashMap TriggerName CronTriggerInfo -> Maybe CronTriggerInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata
q) HashMap TriggerName CronTriggerInfo
cronTriggersMap of
        Maybe CronTriggerInfo
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just CronTriggerInfo
_ ->
          Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
            (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"cron trigger with name: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TriggerName -> Text
triggerNameToTxt (CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata
q)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists"

      let metadataObj :: MetadataObjId
metadataObj = TriggerName -> MetadataObjId
MOCronTrigger TriggerName
_cctName
          metadata :: CronTriggerMetadata
metadata =
            TriggerName
-> InputWebhook
-> CronSchedule
-> Maybe Value
-> STRetryConf
-> [HeaderConf]
-> Bool
-> Maybe Text
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> CronTriggerMetadata
CronTriggerMetadata
              TriggerName
_cctName
              InputWebhook
_cctWebhook
              CronSchedule
_cctCronSchedule
              Maybe Value
_cctPayload
              STRetryConf
_cctRetryConf
              [HeaderConf]
_cctHeaders
              Bool
_cctIncludeInMetadata
              Maybe Text
_cctComment
              Maybe RequestTransform
_cctRequestTransform
              Maybe MetadataResponseTransform
_cctResponseTransform
      MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj
        (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
        ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (CronTriggers -> Identity CronTriggers)
-> Metadata -> Identity Metadata
Lens' Metadata CronTriggers
metaCronTriggers
        ((CronTriggers -> Identity CronTriggers)
 -> Metadata -> Identity Metadata)
-> (CronTriggers -> CronTriggers) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TriggerName -> CronTriggerMetadata -> CronTriggers -> CronTriggers
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert TriggerName
_cctName CronTriggerMetadata
metadata
      CronSchedule -> TriggerName -> m ()
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadMetadataStorage m) =>
CronSchedule -> TriggerName -> m ()
populateInitialCronTriggerEvents CronSchedule
_cctCronSchedule TriggerName
_cctName
      EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

resolveCronTrigger ::
  (QErrM m) =>
  Env.Environment ->
  CronTriggerMetadata ->
  m CronTriggerInfo
resolveCronTrigger :: forall (m :: * -> *).
QErrM m =>
Environment -> CronTriggerMetadata -> m CronTriggerInfo
resolveCronTrigger Environment
env CronTriggerMetadata {Bool
[HeaderConf]
Maybe Text
Maybe Value
Maybe RequestTransform
Maybe MetadataResponseTransform
CronSchedule
InputWebhook
TriggerName
STRetryConf
ctName :: CronTriggerMetadata -> TriggerName
ctName :: TriggerName
ctWebhook :: InputWebhook
ctSchedule :: CronSchedule
ctPayload :: Maybe Value
ctRetryConf :: STRetryConf
ctHeaders :: [HeaderConf]
ctIncludeInMetadata :: Bool
ctComment :: Maybe Text
ctRequestTransform :: Maybe RequestTransform
ctResponseTransform :: Maybe MetadataResponseTransform
ctWebhook :: CronTriggerMetadata -> InputWebhook
ctSchedule :: CronTriggerMetadata -> CronSchedule
ctPayload :: CronTriggerMetadata -> Maybe Value
ctRetryConf :: CronTriggerMetadata -> STRetryConf
ctHeaders :: CronTriggerMetadata -> [HeaderConf]
ctIncludeInMetadata :: CronTriggerMetadata -> Bool
ctComment :: CronTriggerMetadata -> Maybe Text
ctRequestTransform :: CronTriggerMetadata -> Maybe RequestTransform
ctResponseTransform :: CronTriggerMetadata -> Maybe MetadataResponseTransform
..} = do
  ResolvedWebhook
webhookInfo <- Environment -> InputWebhook -> m ResolvedWebhook
forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env InputWebhook
ctWebhook
  [EventHeaderInfo]
headerInfo <- Environment -> [HeaderConf] -> m [EventHeaderInfo]
forall (m :: * -> *).
QErrM m =>
Environment -> [HeaderConf] -> m [EventHeaderInfo]
getHeaderInfosFromConf Environment
env [HeaderConf]
ctHeaders
  let urlTemplate :: Text
urlTemplate = Template -> Text
printTemplate (Template -> Text) -> Template -> Text
forall a b. (a -> b) -> a -> b
$ InputWebhook -> Template
unInputWebhook InputWebhook
ctWebhook
  CronTriggerInfo -> m CronTriggerInfo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (CronTriggerInfo -> m CronTriggerInfo)
-> CronTriggerInfo -> m CronTriggerInfo
forall a b. (a -> b) -> a -> b
$ TriggerName
-> CronSchedule
-> Maybe Value
-> STRetryConf
-> EnvRecord ResolvedWebhook
-> [EventHeaderInfo]
-> Maybe Text
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> CronTriggerInfo
CronTriggerInfo
      TriggerName
ctName
      CronSchedule
ctSchedule
      Maybe Value
ctPayload
      STRetryConf
ctRetryConf
      (Text -> ResolvedWebhook -> EnvRecord ResolvedWebhook
forall a. Text -> a -> EnvRecord a
EnvRecord Text
urlTemplate ResolvedWebhook
webhookInfo)
      [EventHeaderInfo]
headerInfo
      Maybe Text
ctComment
      Maybe RequestTransform
ctRequestTransform
      Maybe MetadataResponseTransform
ctResponseTransform

updateCronTrigger ::
  ( MonadError QErr m,
    CacheRWM m,
    MonadIO m,
    MetadataM m,
    MonadMetadataStorage m
  ) =>
  CronTriggerMetadata ->
  m EncJSON
updateCronTrigger :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MonadIO m, MetadataM m,
 MonadMetadataStorage m) =>
CronTriggerMetadata -> m EncJSON
updateCronTrigger CronTriggerMetadata
cronTriggerMetadata = do
  let triggerName :: TriggerName
triggerName = CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata
cronTriggerMetadata
  TriggerName -> m ()
forall (m :: * -> *).
(CacheRM m, MonadError QErr m) =>
TriggerName -> m ()
checkExists TriggerName
triggerName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (TriggerName -> MetadataObjId
MOCronTrigger TriggerName
triggerName)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (CronTriggers -> Identity CronTriggers)
-> Metadata -> Identity Metadata
Lens' Metadata CronTriggers
metaCronTriggers
    ((CronTriggers -> Identity CronTriggers)
 -> Metadata -> Identity Metadata)
-> (CronTriggers -> CronTriggers) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TriggerName -> CronTriggerMetadata -> CronTriggers -> CronTriggers
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert TriggerName
triggerName CronTriggerMetadata
cronTriggerMetadata
  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ClearCronEvents -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> m (Either QErr ())
dropFutureCronEvents (ClearCronEvents -> m (Either QErr ()))
-> ClearCronEvents -> m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ TriggerName -> ClearCronEvents
SingleCronTrigger TriggerName
triggerName
  UTCTime
currentTime <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
C.getCurrentTime
  let scheduleTimes :: [UTCTime]
scheduleTimes = UTCTime -> Int -> CronSchedule -> [UTCTime]
generateScheduleTimes UTCTime
currentTime Int
100 (CronSchedule -> [UTCTime]) -> CronSchedule -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ CronTriggerMetadata -> CronSchedule
ctSchedule CronTriggerMetadata
cronTriggerMetadata
  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ [CronEventSeed] -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> m (Either QErr ())
insertCronEvents ([CronEventSeed] -> m (Either QErr ()))
-> [CronEventSeed] -> m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ (UTCTime -> CronEventSeed) -> [UTCTime] -> [CronEventSeed]
forall a b. (a -> b) -> [a] -> [b]
map (TriggerName -> UTCTime -> CronEventSeed
CronEventSeed TriggerName
triggerName) [UTCTime]
scheduleTimes
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runDeleteCronTrigger ::
  ( MonadError QErr m,
    CacheRWM m,
    MetadataM m,
    MonadMetadataStorage m
  ) =>
  ScheduledTriggerName ->
  m EncJSON
runDeleteCronTrigger :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m,
 MonadMetadataStorage m) =>
ScheduledTriggerName -> m EncJSON
runDeleteCronTrigger (ScheduledTriggerName TriggerName
stName) = do
  TriggerName -> m ()
forall (m :: * -> *).
(CacheRM m, MonadError QErr m) =>
TriggerName -> m ()
checkExists TriggerName
stName
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ TriggerName -> MetadataModifier
dropCronTriggerInMetadata TriggerName
stName
  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ClearCronEvents -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> m (Either QErr ())
dropFutureCronEvents (ClearCronEvents -> m (Either QErr ()))
-> ClearCronEvents -> m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ TriggerName -> ClearCronEvents
SingleCronTrigger TriggerName
stName
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

dropCronTriggerInMetadata :: TriggerName -> MetadataModifier
dropCronTriggerInMetadata :: TriggerName -> MetadataModifier
dropCronTriggerInMetadata TriggerName
name =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (CronTriggers -> Identity CronTriggers)
-> Metadata -> Identity Metadata
Lens' Metadata CronTriggers
metaCronTriggers ((CronTriggers -> Identity CronTriggers)
 -> Metadata -> Identity Metadata)
-> (CronTriggers -> CronTriggers) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TriggerName -> CronTriggers -> CronTriggers
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete TriggerName
name

runCreateScheduledEvent ::
  (MonadError QErr m, MonadMetadataStorage m) =>
  CreateScheduledEvent ->
  m EncJSON
runCreateScheduledEvent :: forall (m :: * -> *).
(MonadError QErr m, MonadMetadataStorage m) =>
CreateScheduledEvent -> m EncJSON
runCreateScheduledEvent CreateScheduledEvent
scheduledEvent = do
  EventId
eid <- m (Either QErr EventId) -> m EventId
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr EventId) -> m EventId)
-> m (Either QErr EventId) -> m EventId
forall a b. (a -> b) -> a -> b
$ CreateScheduledEvent -> m (Either QErr EventId)
forall (m :: * -> *).
MonadMetadataStorage m =>
CreateScheduledEvent -> m (Either QErr EventId)
createOneOffScheduledEvent CreateScheduledEvent
scheduledEvent
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object [Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text -> Value
J.String Text
"success", Key
"event_id" Key -> EventId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= EventId
eid]

checkExists :: (CacheRM m, MonadError QErr m) => TriggerName -> m ()
checkExists :: forall (m :: * -> *).
(CacheRM m, MonadError QErr m) =>
TriggerName -> m ()
checkExists TriggerName
name = do
  HashMap TriggerName CronTriggerInfo
cronTriggersMap <- SchemaCache -> HashMap TriggerName CronTriggerInfo
scCronTriggers (SchemaCache -> HashMap TriggerName CronTriggerInfo)
-> m SchemaCache -> m (HashMap TriggerName CronTriggerInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  m CronTriggerInfo -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (m CronTriggerInfo -> m ()) -> m CronTriggerInfo -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe CronTriggerInfo -> m CronTriggerInfo -> m CronTriggerInfo
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (TriggerName
-> HashMap TriggerName CronTriggerInfo -> Maybe CronTriggerInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TriggerName
name HashMap TriggerName CronTriggerInfo
cronTriggersMap)
    (m CronTriggerInfo -> m CronTriggerInfo)
-> m CronTriggerInfo -> m CronTriggerInfo
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m CronTriggerInfo
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m CronTriggerInfo) -> Text -> m CronTriggerInfo
forall a b. (a -> b) -> a -> b
$ Text
"cron trigger with name: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TriggerName -> Text
triggerNameToTxt TriggerName
name
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist"

runDeleteScheduledEvent ::
  (MonadMetadataStorage m, MonadError QErr m) => DeleteScheduledEvent -> m EncJSON
runDeleteScheduledEvent :: forall (m :: * -> *).
(MonadMetadataStorage m, MonadError QErr m) =>
DeleteScheduledEvent -> m EncJSON
runDeleteScheduledEvent DeleteScheduledEvent {EventId
ScheduledEventType
_dseType :: ScheduledEventType
_dseEventId :: EventId
_dseType :: DeleteScheduledEvent -> ScheduledEventType
_dseEventId :: DeleteScheduledEvent -> EventId
..} = do
  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ EventId -> ScheduledEventType -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventType -> m (Either QErr ())
dropEvent EventId
_dseEventId ScheduledEventType
_dseType
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runGetScheduledEvents ::
  ( MonadError QErr m,
    CacheRM m,
    MonadMetadataStorage m
  ) =>
  GetScheduledEvents ->
  m EncJSON
runGetScheduledEvents :: forall (m :: * -> *).
(MonadError QErr m, CacheRM m, MonadMetadataStorage m) =>
GetScheduledEvents -> m EncJSON
runGetScheduledEvents GetScheduledEvents
gse = do
  case GetScheduledEvents -> ScheduledEvent
_gseScheduledEvent GetScheduledEvents
gse of
    ScheduledEvent
SEOneOff -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    SECron TriggerName
name -> TriggerName -> m ()
forall (m :: * -> *).
(CacheRM m, MonadError QErr m) =>
TriggerName -> m ()
checkExists TriggerName
name
  Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> m Value -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either QErr Value) -> m Value
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (GetScheduledEvents -> m (Either QErr Value)
forall (m :: * -> *).
MonadMetadataStorage m =>
GetScheduledEvents -> m (Either QErr Value)
fetchScheduledEvents GetScheduledEvents
gse)

runGetScheduledEventInvocations ::
  ( MonadError QErr m,
    CacheRM m,
    MonadMetadataStorage m
  ) =>
  GetScheduledEventInvocations ->
  m EncJSON
runGetScheduledEventInvocations :: forall (m :: * -> *).
(MonadError QErr m, CacheRM m, MonadMetadataStorage m) =>
GetScheduledEventInvocations -> m EncJSON
runGetScheduledEventInvocations getEventInvocations :: GetScheduledEventInvocations
getEventInvocations@GetScheduledEventInvocations {GetScheduledEventInvocationsBy
RowsCountOption
ScheduledEventPagination
_geiInvocationsBy :: GetScheduledEventInvocationsBy
_geiPagination :: ScheduledEventPagination
_geiGetRowsCount :: RowsCountOption
_geiInvocationsBy :: GetScheduledEventInvocations -> GetScheduledEventInvocationsBy
_geiPagination :: GetScheduledEventInvocations -> ScheduledEventPagination
_geiGetRowsCount :: GetScheduledEventInvocations -> RowsCountOption
..} = do
  case GetScheduledEventInvocationsBy
_geiInvocationsBy of
    GIBEventId EventId
_ ScheduledEventType
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    GIBEvent ScheduledEvent
event -> case ScheduledEvent
event of
      ScheduledEvent
SEOneOff -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      SECron TriggerName
name -> TriggerName -> m ()
forall (m :: * -> *).
(CacheRM m, MonadError QErr m) =>
TriggerName -> m ()
checkExists TriggerName
name
  WithOptionalTotalCount Maybe Int
countMaybe [ScheduledEventInvocation]
invocations <- m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
-> m (WithOptionalTotalCount [ScheduledEventInvocation])
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either
      QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
 -> m (WithOptionalTotalCount [ScheduledEventInvocation]))
-> m (Either
        QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
-> m (WithOptionalTotalCount [ScheduledEventInvocation])
forall a b. (a -> b) -> a -> b
$ GetScheduledEventInvocations
-> m (Either
        QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
forall (m :: * -> *).
MonadMetadataStorage m =>
GetScheduledEventInvocations
-> m (Either
        QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
fetchScheduledEventInvocations GetScheduledEventInvocations
getEventInvocations
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue
    (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object
    ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"invocations" Key -> [ScheduledEventInvocation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [ScheduledEventInvocation]
invocations)
    Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: ([Pair] -> (Int -> [Pair]) -> Maybe Int -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair]
forall a. Monoid a => a
mempty (\Int
count -> [Key
"count" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Int
count]) Maybe Int
countMaybe)

-- | Metadata API handler to retrieve all the cron triggers from the metadata
runGetCronTriggers :: (MetadataM m) => m EncJSON
runGetCronTriggers :: forall (m :: * -> *). MetadataM m => m EncJSON
runGetCronTriggers = do
  [CronTriggerMetadata]
cronTriggers <- CronTriggers -> [CronTriggerMetadata]
forall a. InsOrdHashMap TriggerName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (CronTriggers -> [CronTriggerMetadata])
-> (Metadata -> CronTriggers) -> Metadata -> [CronTriggerMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> CronTriggers
_metaCronTriggers (Metadata -> [CronTriggerMetadata])
-> m Metadata -> m [CronTriggerMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue
    (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object
      [Key
"cron_triggers" Key -> [CronTriggerMetadata] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [CronTriggerMetadata]
cronTriggers]