{-# LANGUAGE TemplateHaskell #-}

-- | These are types for Scheduled Trigger definition; see "Hasura.Eventing.ScheduledTrigger"
module Hasura.RQL.Types.ScheduledTrigger
  ( ScheduledTriggerName (..),
    CronTriggerMetadata (..),
    CreateCronTrigger (..),
    STRetryConf (..),
    CreateScheduledEvent (..),
    CronEventId,
    OneOffScheduledEventId,
    formatTime',
    defaultSTRetryConf,
    ScheduledEventId,
    InvocationId,
    CronEventSeed (..),
    OneOffEvent,
    ScheduledEventStatus (..),
    scheduledEventStatusToText,
    ScheduledEventType (..),
    ScheduledEvent (..),
    ScheduledEventInvocation (..),
    OneOffScheduledEvent (..),
    CronEvent (..),
    RowsCountOption (..),
    ScheduledEventPagination (..),
    GetScheduledEvents (..),
    WithOptionalTotalCount (..),
    DeleteScheduledEvent (..),
    GetScheduledEventInvocationsBy (..),
    GetScheduledEventInvocations (..),
    ClearCronEvents (..),
    cctName,
    cctWebhook,
    cctCronSchedule,
    cctPayload,
    cctRetryConf,
    cctHeaders,
    cctIncludeInMetadata,
    cctComment,
    cctReplace,
    cctRequestTransform,
    cctResponseTransform,
  )
where

import Autodocodec (HasCodec (codec), bimapCodec, optionalField', optionalFieldWithDefaultWith', optionalFieldWithOmittedDefault', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (refinedCodec)
import Control.Lens (makeLenses)
import Data.Aeson
import Data.Aeson qualified as J
import Data.Aeson.Casing
import Data.Aeson.Types
import Data.Text qualified as T
import Data.Time.Clock
import Data.Time.Clock.Units
import Data.Time.Format.ISO8601
import Database.PG.Query qualified as PG
import Hasura.Prelude
import Hasura.RQL.Types.Common (InputWebhook (..))
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Eventing
import Hasura.RQL.Types.Webhook.Transform (MetadataResponseTransform, RequestTransform)
import PostgreSQL.Binary.Decoding qualified as PD
import Refined (NonNegative, Refined, refineTH)
import System.Cron.Types

type CronEventId = EventId

type OneOffScheduledEventId = EventId

type ScheduledEventId = EventId

type InvocationId = Text

data STRetryConf = STRetryConf
  { STRetryConf -> Int
strcNumRetries :: Int,
    STRetryConf -> Refined NonNegative DiffTime
strcRetryIntervalSeconds :: Refined NonNegative DiffTime,
    STRetryConf -> Refined NonNegative DiffTime
strcTimeoutSeconds :: Refined NonNegative DiffTime,
    -- | The tolerance configuration is used to determine whether a scheduled
    --   event is not too old to process. The age of the scheduled event is the
    --   difference between the current timestamp and the scheduled event's
    --   timestamp, if the age is than the tolerance then the scheduled event
    --   is marked as dead.
    STRetryConf -> Refined NonNegative DiffTime
strcToleranceSeconds :: Refined NonNegative DiffTime
  }
  deriving (Int -> STRetryConf -> ShowS
[STRetryConf] -> ShowS
STRetryConf -> String
(Int -> STRetryConf -> ShowS)
-> (STRetryConf -> String)
-> ([STRetryConf] -> ShowS)
-> Show STRetryConf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> STRetryConf -> ShowS
showsPrec :: Int -> STRetryConf -> ShowS
$cshow :: STRetryConf -> String
show :: STRetryConf -> String
$cshowList :: [STRetryConf] -> ShowS
showList :: [STRetryConf] -> ShowS
Show, STRetryConf -> STRetryConf -> Bool
(STRetryConf -> STRetryConf -> Bool)
-> (STRetryConf -> STRetryConf -> Bool) -> Eq STRetryConf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: STRetryConf -> STRetryConf -> Bool
== :: STRetryConf -> STRetryConf -> Bool
$c/= :: STRetryConf -> STRetryConf -> Bool
/= :: STRetryConf -> STRetryConf -> Bool
Eq, (forall x. STRetryConf -> Rep STRetryConf x)
-> (forall x. Rep STRetryConf x -> STRetryConf)
-> Generic STRetryConf
forall x. Rep STRetryConf x -> STRetryConf
forall x. STRetryConf -> Rep STRetryConf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. STRetryConf -> Rep STRetryConf x
from :: forall x. STRetryConf -> Rep STRetryConf x
$cto :: forall x. Rep STRetryConf x -> STRetryConf
to :: forall x. Rep STRetryConf x -> STRetryConf
Generic)

defaultSTRetryConf :: STRetryConf
defaultSTRetryConf :: STRetryConf
defaultSTRetryConf =
  STRetryConf
    { strcNumRetries :: Int
strcNumRetries = Int
0,
      strcRetryIntervalSeconds :: Refined NonNegative DiffTime
strcRetryIntervalSeconds = $$(refineTH (seconds 10)),
      strcTimeoutSeconds :: Refined NonNegative DiffTime
strcTimeoutSeconds = $$(refineTH (seconds 60)),
      strcToleranceSeconds :: Refined NonNegative DiffTime
strcToleranceSeconds = $$(refineTH (hours 6))
    }

instance NFData STRetryConf

instance HasCodec STRetryConf where
  codec :: JSONCodec STRetryConf
codec =
    Text
-> ObjectCodec STRetryConf STRetryConf -> JSONCodec STRetryConf
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"STRetryConf"
      (ObjectCodec STRetryConf STRetryConf -> JSONCodec STRetryConf)
-> ObjectCodec STRetryConf STRetryConf -> JSONCodec STRetryConf
forall a b. (a -> b) -> a -> b
$ Int
-> Refined NonNegative DiffTime
-> Refined NonNegative DiffTime
-> Refined NonNegative DiffTime
-> STRetryConf
STRetryConf
      (Int
 -> Refined NonNegative DiffTime
 -> Refined NonNegative DiffTime
 -> Refined NonNegative DiffTime
 -> STRetryConf)
-> Codec Object STRetryConf Int
-> Codec
     Object
     STRetryConf
     (Refined NonNegative DiffTime
      -> Refined NonNegative DiffTime
      -> Refined NonNegative DiffTime
      -> STRetryConf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> JSONCodec Int -> Int -> ObjectCodec Int Int
forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
"num_retries" JSONCodec Int
nonNegativeCodec (STRetryConf -> Int
strcNumRetries STRetryConf
defaultSTRetryConf)
      ObjectCodec Int Int
-> (STRetryConf -> Int) -> Codec Object STRetryConf Int
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= STRetryConf -> Int
strcNumRetries
        Codec
  Object
  STRetryConf
  (Refined NonNegative DiffTime
   -> Refined NonNegative DiffTime
   -> Refined NonNegative DiffTime
   -> STRetryConf)
-> Codec Object STRetryConf (Refined NonNegative DiffTime)
-> Codec
     Object
     STRetryConf
     (Refined NonNegative DiffTime
      -> Refined NonNegative DiffTime -> STRetryConf)
forall a b.
Codec Object STRetryConf (a -> b)
-> Codec Object STRetryConf a -> Codec Object STRetryConf b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (Refined NonNegative DiffTime)
-> Refined NonNegative DiffTime
-> ObjectCodec
     (Refined NonNegative DiffTime) (Refined NonNegative DiffTime)
forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
"retry_interval_seconds" JSONCodec (Refined NonNegative DiffTime)
forall {k} a (p :: k).
(HasCodec a, Predicate p a) =>
JSONCodec (Refined p a)
refinedCodec (STRetryConf -> Refined NonNegative DiffTime
strcRetryIntervalSeconds STRetryConf
defaultSTRetryConf)
      ObjectCodec
  (Refined NonNegative DiffTime) (Refined NonNegative DiffTime)
-> (STRetryConf -> Refined NonNegative DiffTime)
-> Codec Object STRetryConf (Refined NonNegative DiffTime)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= STRetryConf -> Refined NonNegative DiffTime
strcRetryIntervalSeconds
        Codec
  Object
  STRetryConf
  (Refined NonNegative DiffTime
   -> Refined NonNegative DiffTime -> STRetryConf)
-> Codec Object STRetryConf (Refined NonNegative DiffTime)
-> Codec
     Object STRetryConf (Refined NonNegative DiffTime -> STRetryConf)
forall a b.
Codec Object STRetryConf (a -> b)
-> Codec Object STRetryConf a -> Codec Object STRetryConf b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (Refined NonNegative DiffTime)
-> Refined NonNegative DiffTime
-> ObjectCodec
     (Refined NonNegative DiffTime) (Refined NonNegative DiffTime)
forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
"timeout_seconds" JSONCodec (Refined NonNegative DiffTime)
forall {k} a (p :: k).
(HasCodec a, Predicate p a) =>
JSONCodec (Refined p a)
refinedCodec (STRetryConf -> Refined NonNegative DiffTime
strcTimeoutSeconds STRetryConf
defaultSTRetryConf)
      ObjectCodec
  (Refined NonNegative DiffTime) (Refined NonNegative DiffTime)
-> (STRetryConf -> Refined NonNegative DiffTime)
-> Codec Object STRetryConf (Refined NonNegative DiffTime)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= STRetryConf -> Refined NonNegative DiffTime
strcTimeoutSeconds
        Codec
  Object STRetryConf (Refined NonNegative DiffTime -> STRetryConf)
-> Codec Object STRetryConf (Refined NonNegative DiffTime)
-> ObjectCodec STRetryConf STRetryConf
forall a b.
Codec Object STRetryConf (a -> b)
-> Codec Object STRetryConf a -> Codec Object STRetryConf b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (Refined NonNegative DiffTime)
-> Refined NonNegative DiffTime
-> ObjectCodec
     (Refined NonNegative DiffTime) (Refined NonNegative DiffTime)
forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
"tolerance_seconds" JSONCodec (Refined NonNegative DiffTime)
forall {k} a (p :: k).
(HasCodec a, Predicate p a) =>
JSONCodec (Refined p a)
refinedCodec (STRetryConf -> Refined NonNegative DiffTime
strcToleranceSeconds STRetryConf
defaultSTRetryConf)
      ObjectCodec
  (Refined NonNegative DiffTime) (Refined NonNegative DiffTime)
-> (STRetryConf -> Refined NonNegative DiffTime)
-> Codec Object STRetryConf (Refined NonNegative DiffTime)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= STRetryConf -> Refined NonNegative DiffTime
strcToleranceSeconds
    where
      nonNegativeCodec :: JSONCodec Int
nonNegativeCodec = (Int -> Either String Int)
-> (Int -> Int) -> JSONCodec Int -> JSONCodec Int
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Int -> Either String Int
forall {b} {a}. (Ord b, Num b, IsString a) => b -> Either a b
validateNonNegative Int -> Int
forall a. a -> a
id JSONCodec Int
forall value. HasCodec value => JSONCodec value
codec
      validateNonNegative :: b -> Either a b
validateNonNegative b
n =
        if b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0
          then a -> Either a b
forall a b. a -> Either a b
Left a
"cannot be a negative value"
          else b -> Either a b
forall a b. b -> Either a b
Right b
n

instance FromJSON STRetryConf where
  parseJSON :: Value -> Parser STRetryConf
parseJSON = String
-> (Object -> Parser STRetryConf) -> Value -> Parser STRetryConf
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"STRetryConf" \Object
o -> do
    Int
numRetries' <- Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"num_retries" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    Refined NonNegative DiffTime
retryInterval <-
      Object
o Object -> Key -> Parser (Maybe (Refined NonNegative DiffTime))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry_interval_seconds" Parser (Maybe (Refined NonNegative DiffTime))
-> Refined NonNegative DiffTime
-> Parser (Refined NonNegative DiffTime)
forall a. Parser (Maybe a) -> a -> Parser a
.!= $$(refineTH @NonNegative @DiffTime (seconds 10))
    Refined NonNegative DiffTime
timeout <-
      Object
o Object -> Key -> Parser (Maybe (Refined NonNegative DiffTime))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timeout_seconds" Parser (Maybe (Refined NonNegative DiffTime))
-> Refined NonNegative DiffTime
-> Parser (Refined NonNegative DiffTime)
forall a. Parser (Maybe a) -> a -> Parser a
.!= $$(refineTH @NonNegative @DiffTime (seconds 60))
    Refined NonNegative DiffTime
tolerance <-
      Object
o Object -> Key -> Parser (Maybe (Refined NonNegative DiffTime))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tolerance_seconds" Parser (Maybe (Refined NonNegative DiffTime))
-> Refined NonNegative DiffTime
-> Parser (Refined NonNegative DiffTime)
forall a. Parser (Maybe a) -> a -> Parser a
.!= $$(refineTH @NonNegative @DiffTime (hours 6))
    if Int
numRetries' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
      then String -> Parser STRetryConf
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"num_retries cannot be a negative value"
      else STRetryConf -> Parser STRetryConf
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STRetryConf -> Parser STRetryConf)
-> STRetryConf -> Parser STRetryConf
forall a b. (a -> b) -> a -> b
$ Int
-> Refined NonNegative DiffTime
-> Refined NonNegative DiffTime
-> Refined NonNegative DiffTime
-> STRetryConf
STRetryConf Int
numRetries' Refined NonNegative DiffTime
retryInterval Refined NonNegative DiffTime
timeout Refined NonNegative DiffTime
tolerance

instance ToJSON STRetryConf where
  toJSON :: STRetryConf -> Value
toJSON = Options -> STRetryConf -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: STRetryConf -> Encoding
toEncoding = Options -> STRetryConf -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

data CronTriggerMetadata = CronTriggerMetadata
  { CronTriggerMetadata -> TriggerName
ctName :: TriggerName,
    CronTriggerMetadata -> InputWebhook
ctWebhook :: InputWebhook,
    CronTriggerMetadata -> CronSchedule
ctSchedule :: CronSchedule,
    CronTriggerMetadata -> Maybe Value
ctPayload :: Maybe J.Value,
    CronTriggerMetadata -> STRetryConf
ctRetryConf :: STRetryConf,
    CronTriggerMetadata -> [HeaderConf]
ctHeaders :: [HeaderConf],
    CronTriggerMetadata -> Bool
ctIncludeInMetadata :: Bool,
    CronTriggerMetadata -> Maybe Text
ctComment :: Maybe Text,
    CronTriggerMetadata -> Maybe RequestTransform
ctRequestTransform :: Maybe RequestTransform,
    CronTriggerMetadata -> Maybe MetadataResponseTransform
ctResponseTransform :: Maybe MetadataResponseTransform
  }
  deriving (Int -> CronTriggerMetadata -> ShowS
[CronTriggerMetadata] -> ShowS
CronTriggerMetadata -> String
(Int -> CronTriggerMetadata -> ShowS)
-> (CronTriggerMetadata -> String)
-> ([CronTriggerMetadata] -> ShowS)
-> Show CronTriggerMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronTriggerMetadata -> ShowS
showsPrec :: Int -> CronTriggerMetadata -> ShowS
$cshow :: CronTriggerMetadata -> String
show :: CronTriggerMetadata -> String
$cshowList :: [CronTriggerMetadata] -> ShowS
showList :: [CronTriggerMetadata] -> ShowS
Show, CronTriggerMetadata -> CronTriggerMetadata -> Bool
(CronTriggerMetadata -> CronTriggerMetadata -> Bool)
-> (CronTriggerMetadata -> CronTriggerMetadata -> Bool)
-> Eq CronTriggerMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronTriggerMetadata -> CronTriggerMetadata -> Bool
== :: CronTriggerMetadata -> CronTriggerMetadata -> Bool
$c/= :: CronTriggerMetadata -> CronTriggerMetadata -> Bool
/= :: CronTriggerMetadata -> CronTriggerMetadata -> Bool
Eq, (forall x. CronTriggerMetadata -> Rep CronTriggerMetadata x)
-> (forall x. Rep CronTriggerMetadata x -> CronTriggerMetadata)
-> Generic CronTriggerMetadata
forall x. Rep CronTriggerMetadata x -> CronTriggerMetadata
forall x. CronTriggerMetadata -> Rep CronTriggerMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CronTriggerMetadata -> Rep CronTriggerMetadata x
from :: forall x. CronTriggerMetadata -> Rep CronTriggerMetadata x
$cto :: forall x. Rep CronTriggerMetadata x -> CronTriggerMetadata
to :: forall x. Rep CronTriggerMetadata x -> CronTriggerMetadata
Generic)

instance NFData CronTriggerMetadata

instance HasCodec CronTriggerMetadata where
  codec :: JSONCodec CronTriggerMetadata
codec =
    Text
-> ObjectCodec CronTriggerMetadata CronTriggerMetadata
-> JSONCodec CronTriggerMetadata
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"CronTriggerMetadata"
      (ObjectCodec CronTriggerMetadata CronTriggerMetadata
 -> JSONCodec CronTriggerMetadata)
-> ObjectCodec CronTriggerMetadata CronTriggerMetadata
-> JSONCodec CronTriggerMetadata
forall a b. (a -> b) -> a -> b
$ TriggerName
-> InputWebhook
-> CronSchedule
-> Maybe Value
-> STRetryConf
-> [HeaderConf]
-> Bool
-> Maybe Text
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> CronTriggerMetadata
CronTriggerMetadata
      (TriggerName
 -> InputWebhook
 -> CronSchedule
 -> Maybe Value
 -> STRetryConf
 -> [HeaderConf]
 -> Bool
 -> Maybe Text
 -> Maybe RequestTransform
 -> Maybe MetadataResponseTransform
 -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata TriggerName
-> Codec
     Object
     CronTriggerMetadata
     (InputWebhook
      -> CronSchedule
      -> Maybe Value
      -> STRetryConf
      -> [HeaderConf]
      -> Bool
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CronTriggerMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec TriggerName TriggerName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec TriggerName TriggerName
-> (CronTriggerMetadata -> TriggerName)
-> Codec Object CronTriggerMetadata TriggerName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> TriggerName
ctName
        Codec
  Object
  CronTriggerMetadata
  (InputWebhook
   -> CronSchedule
   -> Maybe Value
   -> STRetryConf
   -> [HeaderConf]
   -> Bool
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata InputWebhook
-> Codec
     Object
     CronTriggerMetadata
     (CronSchedule
      -> Maybe Value
      -> STRetryConf
      -> [HeaderConf]
      -> Bool
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec InputWebhook InputWebhook
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"webhook"
      ObjectCodec InputWebhook InputWebhook
-> (CronTriggerMetadata -> InputWebhook)
-> Codec Object CronTriggerMetadata InputWebhook
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> InputWebhook
ctWebhook
        Codec
  Object
  CronTriggerMetadata
  (CronSchedule
   -> Maybe Value
   -> STRetryConf
   -> [HeaderConf]
   -> Bool
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata CronSchedule
-> Codec
     Object
     CronTriggerMetadata
     (Maybe Value
      -> STRetryConf
      -> [HeaderConf]
      -> Bool
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CronSchedule CronSchedule
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"schedule"
      ObjectCodec CronSchedule CronSchedule
-> (CronTriggerMetadata -> CronSchedule)
-> Codec Object CronTriggerMetadata CronSchedule
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> CronSchedule
ctSchedule
        Codec
  Object
  CronTriggerMetadata
  (Maybe Value
   -> STRetryConf
   -> [HeaderConf]
   -> Bool
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata (Maybe Value)
-> Codec
     Object
     CronTriggerMetadata
     (STRetryConf
      -> [HeaderConf]
      -> Bool
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Value) (Maybe Value)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"payload"
      ObjectCodec (Maybe Value) (Maybe Value)
-> (CronTriggerMetadata -> Maybe Value)
-> Codec Object CronTriggerMetadata (Maybe Value)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> Maybe Value
ctPayload
        Codec
  Object
  CronTriggerMetadata
  (STRetryConf
   -> [HeaderConf]
   -> Bool
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata STRetryConf
-> Codec
     Object
     CronTriggerMetadata
     ([HeaderConf]
      -> Bool
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> STRetryConf -> ObjectCodec STRetryConf STRetryConf
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"retry_conf" STRetryConf
defaultSTRetryConf
      ObjectCodec STRetryConf STRetryConf
-> (CronTriggerMetadata -> STRetryConf)
-> Codec Object CronTriggerMetadata STRetryConf
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> STRetryConf
ctRetryConf
        Codec
  Object
  CronTriggerMetadata
  ([HeaderConf]
   -> Bool
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata [HeaderConf]
-> Codec
     Object
     CronTriggerMetadata
     (Bool
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> [HeaderConf] -> ObjectCodec [HeaderConf] [HeaderConf]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"headers" []
      ObjectCodec [HeaderConf] [HeaderConf]
-> (CronTriggerMetadata -> [HeaderConf])
-> Codec Object CronTriggerMetadata [HeaderConf]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> [HeaderConf]
ctHeaders
        Codec
  Object
  CronTriggerMetadata
  (Bool
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata Bool
-> Codec
     Object
     CronTriggerMetadata
     (Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"include_in_metadata"
      ObjectCodec Bool Bool
-> (CronTriggerMetadata -> Bool)
-> Codec Object CronTriggerMetadata Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> Bool
ctIncludeInMetadata
        Codec
  Object
  CronTriggerMetadata
  (Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata (Maybe Text)
-> Codec
     Object
     CronTriggerMetadata
     (Maybe RequestTransform
      -> Maybe MetadataResponseTransform -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"comment"
      ObjectCodec (Maybe Text) (Maybe Text)
-> (CronTriggerMetadata -> Maybe Text)
-> Codec Object CronTriggerMetadata (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> Maybe Text
ctComment
        Codec
  Object
  CronTriggerMetadata
  (Maybe RequestTransform
   -> Maybe MetadataResponseTransform -> CronTriggerMetadata)
-> Codec Object CronTriggerMetadata (Maybe RequestTransform)
-> Codec
     Object
     CronTriggerMetadata
     (Maybe MetadataResponseTransform -> CronTriggerMetadata)
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec (Maybe RequestTransform) (Maybe RequestTransform)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"request_transform"
      ObjectCodec (Maybe RequestTransform) (Maybe RequestTransform)
-> (CronTriggerMetadata -> Maybe RequestTransform)
-> Codec Object CronTriggerMetadata (Maybe RequestTransform)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> Maybe RequestTransform
ctRequestTransform
        Codec
  Object
  CronTriggerMetadata
  (Maybe MetadataResponseTransform -> CronTriggerMetadata)
-> Codec
     Object CronTriggerMetadata (Maybe MetadataResponseTransform)
-> ObjectCodec CronTriggerMetadata CronTriggerMetadata
forall a b.
Codec Object CronTriggerMetadata (a -> b)
-> Codec Object CronTriggerMetadata a
-> Codec Object CronTriggerMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe MetadataResponseTransform) (Maybe MetadataResponseTransform)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"response_transform"
      ObjectCodec
  (Maybe MetadataResponseTransform) (Maybe MetadataResponseTransform)
-> (CronTriggerMetadata -> Maybe MetadataResponseTransform)
-> Codec
     Object CronTriggerMetadata (Maybe MetadataResponseTransform)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CronTriggerMetadata -> Maybe MetadataResponseTransform
ctResponseTransform

instance FromJSON CronTriggerMetadata where
  parseJSON :: Value -> Parser CronTriggerMetadata
parseJSON =
    String
-> (Object -> Parser CronTriggerMetadata)
-> Value
-> Parser CronTriggerMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CronTriggerMetadata" ((Object -> Parser CronTriggerMetadata)
 -> Value -> Parser CronTriggerMetadata)
-> (Object -> Parser CronTriggerMetadata)
-> Value
-> Parser CronTriggerMetadata
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      TriggerName
ctName <- Object
o Object -> Key -> Parser TriggerName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      InputWebhook
ctWebhook <- Object
o Object -> Key -> Parser InputWebhook
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"webhook"
      Maybe Value
ctPayload <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload"
      CronSchedule
ctSchedule <- Object
o Object -> Key -> Parser CronSchedule
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schedule"
      STRetryConf
ctRetryConf <- Object
o Object -> Key -> Parser (Maybe STRetryConf)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry_conf" Parser (Maybe STRetryConf) -> STRetryConf -> Parser STRetryConf
forall a. Parser (Maybe a) -> a -> Parser a
.!= STRetryConf
defaultSTRetryConf
      [HeaderConf]
ctHeaders <- Object
o Object -> Key -> Parser (Maybe [HeaderConf])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe [HeaderConf]) -> [HeaderConf] -> Parser [HeaderConf]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Bool
ctIncludeInMetadata <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"include_in_metadata"
      Maybe Text
ctComment <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"
      Maybe RequestTransform
ctRequestTransform <- Object
o Object -> Key -> Parser (Maybe RequestTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_transform"
      Maybe MetadataResponseTransform
ctResponseTransform <- Object
o Object -> Key -> Parser (Maybe MetadataResponseTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_transform"
      CronTriggerMetadata -> Parser CronTriggerMetadata
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CronTriggerMetadata {Bool
[HeaderConf]
Maybe Text
Maybe Value
Maybe RequestTransform
Maybe MetadataResponseTransform
CronSchedule
InputWebhook
TriggerName
STRetryConf
ctName :: TriggerName
ctWebhook :: InputWebhook
ctSchedule :: CronSchedule
ctPayload :: Maybe Value
ctRetryConf :: STRetryConf
ctHeaders :: [HeaderConf]
ctIncludeInMetadata :: Bool
ctComment :: Maybe Text
ctRequestTransform :: Maybe RequestTransform
ctResponseTransform :: Maybe MetadataResponseTransform
ctName :: TriggerName
ctWebhook :: InputWebhook
ctPayload :: Maybe Value
ctSchedule :: CronSchedule
ctRetryConf :: STRetryConf
ctHeaders :: [HeaderConf]
ctIncludeInMetadata :: Bool
ctComment :: Maybe Text
ctRequestTransform :: Maybe RequestTransform
ctResponseTransform :: Maybe MetadataResponseTransform
..}

instance ToJSON CronTriggerMetadata where
  toJSON :: CronTriggerMetadata -> Value
toJSON = Options -> CronTriggerMetadata -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: CronTriggerMetadata -> Encoding
toEncoding = Options -> CronTriggerMetadata -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

data CreateCronTrigger = CreateCronTrigger
  { CreateCronTrigger -> TriggerName
_cctName :: TriggerName,
    CreateCronTrigger -> InputWebhook
_cctWebhook :: InputWebhook,
    CreateCronTrigger -> CronSchedule
_cctCronSchedule :: CronSchedule,
    CreateCronTrigger -> Maybe Value
_cctPayload :: Maybe J.Value,
    CreateCronTrigger -> STRetryConf
_cctRetryConf :: STRetryConf,
    CreateCronTrigger -> [HeaderConf]
_cctHeaders :: [HeaderConf],
    CreateCronTrigger -> Bool
_cctIncludeInMetadata :: Bool,
    CreateCronTrigger -> Maybe Text
_cctComment :: Maybe Text,
    CreateCronTrigger -> Bool
_cctReplace :: Bool,
    CreateCronTrigger -> Maybe RequestTransform
_cctRequestTransform :: Maybe RequestTransform,
    CreateCronTrigger -> Maybe MetadataResponseTransform
_cctResponseTransform :: Maybe MetadataResponseTransform
  }
  deriving (Int -> CreateCronTrigger -> ShowS
[CreateCronTrigger] -> ShowS
CreateCronTrigger -> String
(Int -> CreateCronTrigger -> ShowS)
-> (CreateCronTrigger -> String)
-> ([CreateCronTrigger] -> ShowS)
-> Show CreateCronTrigger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateCronTrigger -> ShowS
showsPrec :: Int -> CreateCronTrigger -> ShowS
$cshow :: CreateCronTrigger -> String
show :: CreateCronTrigger -> String
$cshowList :: [CreateCronTrigger] -> ShowS
showList :: [CreateCronTrigger] -> ShowS
Show, CreateCronTrigger -> CreateCronTrigger -> Bool
(CreateCronTrigger -> CreateCronTrigger -> Bool)
-> (CreateCronTrigger -> CreateCronTrigger -> Bool)
-> Eq CreateCronTrigger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateCronTrigger -> CreateCronTrigger -> Bool
== :: CreateCronTrigger -> CreateCronTrigger -> Bool
$c/= :: CreateCronTrigger -> CreateCronTrigger -> Bool
/= :: CreateCronTrigger -> CreateCronTrigger -> Bool
Eq, (forall x. CreateCronTrigger -> Rep CreateCronTrigger x)
-> (forall x. Rep CreateCronTrigger x -> CreateCronTrigger)
-> Generic CreateCronTrigger
forall x. Rep CreateCronTrigger x -> CreateCronTrigger
forall x. CreateCronTrigger -> Rep CreateCronTrigger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateCronTrigger -> Rep CreateCronTrigger x
from :: forall x. CreateCronTrigger -> Rep CreateCronTrigger x
$cto :: forall x. Rep CreateCronTrigger x -> CreateCronTrigger
to :: forall x. Rep CreateCronTrigger x -> CreateCronTrigger
Generic)

$(makeLenses ''CreateCronTrigger)

instance NFData CreateCronTrigger

instance FromJSON CreateCronTrigger where
  parseJSON :: Value -> Parser CreateCronTrigger
parseJSON =
    String
-> (Object -> Parser CreateCronTrigger)
-> Value
-> Parser CreateCronTrigger
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateCronTrigger" ((Object -> Parser CreateCronTrigger)
 -> Value -> Parser CreateCronTrigger)
-> (Object -> Parser CreateCronTrigger)
-> Value
-> Parser CreateCronTrigger
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      TriggerName
_cctName <- Object
o Object -> Key -> Parser TriggerName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      InputWebhook
_cctWebhook <- Object
o Object -> Key -> Parser InputWebhook
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"webhook"
      Maybe Value
_cctPayload <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload"
      CronSchedule
_cctCronSchedule <- Object
o Object -> Key -> Parser CronSchedule
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schedule"
      STRetryConf
_cctRetryConf <- Object
o Object -> Key -> Parser (Maybe STRetryConf)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry_conf" Parser (Maybe STRetryConf) -> STRetryConf -> Parser STRetryConf
forall a. Parser (Maybe a) -> a -> Parser a
.!= STRetryConf
defaultSTRetryConf
      [HeaderConf]
_cctHeaders <- Object
o Object -> Key -> Parser (Maybe [HeaderConf])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe [HeaderConf]) -> [HeaderConf] -> Parser [HeaderConf]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Bool
_cctIncludeInMetadata <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"include_in_metadata"
      Maybe Text
_cctComment <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"
      Bool
_cctReplace <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"replace" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Maybe RequestTransform
_cctRequestTransform <- Object
o Object -> Key -> Parser (Maybe RequestTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_transform"
      Maybe MetadataResponseTransform
_cctResponseTransform <- Object
o Object -> Key -> Parser (Maybe MetadataResponseTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_transform"
      CreateCronTrigger -> Parser CreateCronTrigger
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: TriggerName
_cctWebhook :: InputWebhook
_cctPayload :: Maybe Value
_cctCronSchedule :: CronSchedule
_cctRetryConf :: STRetryConf
_cctHeaders :: [HeaderConf]
_cctIncludeInMetadata :: Bool
_cctComment :: Maybe Text
_cctReplace :: Bool
_cctRequestTransform :: Maybe RequestTransform
_cctResponseTransform :: Maybe MetadataResponseTransform
..}

instance ToJSON CreateCronTrigger where
  toJSON :: CreateCronTrigger -> Value
toJSON = Options -> CreateCronTrigger -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: CreateCronTrigger -> Encoding
toEncoding = Options -> CreateCronTrigger -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

newtype ScheduledTriggerName = ScheduledTriggerName {ScheduledTriggerName -> TriggerName
unName :: TriggerName}
  deriving stock (Int -> ScheduledTriggerName -> ShowS
[ScheduledTriggerName] -> ShowS
ScheduledTriggerName -> String
(Int -> ScheduledTriggerName -> ShowS)
-> (ScheduledTriggerName -> String)
-> ([ScheduledTriggerName] -> ShowS)
-> Show ScheduledTriggerName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduledTriggerName -> ShowS
showsPrec :: Int -> ScheduledTriggerName -> ShowS
$cshow :: ScheduledTriggerName -> String
show :: ScheduledTriggerName -> String
$cshowList :: [ScheduledTriggerName] -> ShowS
showList :: [ScheduledTriggerName] -> ShowS
Show, ScheduledTriggerName -> ScheduledTriggerName -> Bool
(ScheduledTriggerName -> ScheduledTriggerName -> Bool)
-> (ScheduledTriggerName -> ScheduledTriggerName -> Bool)
-> Eq ScheduledTriggerName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduledTriggerName -> ScheduledTriggerName -> Bool
== :: ScheduledTriggerName -> ScheduledTriggerName -> Bool
$c/= :: ScheduledTriggerName -> ScheduledTriggerName -> Bool
/= :: ScheduledTriggerName -> ScheduledTriggerName -> Bool
Eq, (forall x. ScheduledTriggerName -> Rep ScheduledTriggerName x)
-> (forall x. Rep ScheduledTriggerName x -> ScheduledTriggerName)
-> Generic ScheduledTriggerName
forall x. Rep ScheduledTriggerName x -> ScheduledTriggerName
forall x. ScheduledTriggerName -> Rep ScheduledTriggerName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduledTriggerName -> Rep ScheduledTriggerName x
from :: forall x. ScheduledTriggerName -> Rep ScheduledTriggerName x
$cto :: forall x. Rep ScheduledTriggerName x -> ScheduledTriggerName
to :: forall x. Rep ScheduledTriggerName x -> ScheduledTriggerName
Generic)

instance FromJSON ScheduledTriggerName where
  parseJSON :: Value -> Parser ScheduledTriggerName
parseJSON = Options -> Value -> Parser ScheduledTriggerName
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance ToJSON ScheduledTriggerName where
  toJSON :: ScheduledTriggerName -> Value
toJSON = Options -> ScheduledTriggerName -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: ScheduledTriggerName -> Encoding
toEncoding = Options -> ScheduledTriggerName -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

formatTime' :: UTCTime -> Text
formatTime' :: UTCTime -> Text
formatTime' = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show

data CreateScheduledEvent = CreateScheduledEvent
  { CreateScheduledEvent -> InputWebhook
cseWebhook :: InputWebhook,
    -- | The timestamp should be in the
    -- <ISO 8601 https://en.wikipedia.org/wiki/ISO_8601>
    -- format (which is what @aeson@ expects by default for 'UTCTime').
    CreateScheduledEvent -> UTCTime
cseScheduleAt :: UTCTime,
    CreateScheduledEvent -> Maybe Value
csePayload :: Maybe J.Value,
    CreateScheduledEvent -> [HeaderConf]
cseHeaders :: [HeaderConf],
    CreateScheduledEvent -> STRetryConf
cseRetryConf :: STRetryConf,
    CreateScheduledEvent -> Maybe Text
cseComment :: Maybe Text,
    CreateScheduledEvent -> Maybe RequestTransform
cseRequestTransform :: Maybe RequestTransform,
    CreateScheduledEvent -> Maybe MetadataResponseTransform
cseResponseTransform :: Maybe MetadataResponseTransform
  }
  deriving (Int -> CreateScheduledEvent -> ShowS
[CreateScheduledEvent] -> ShowS
CreateScheduledEvent -> String
(Int -> CreateScheduledEvent -> ShowS)
-> (CreateScheduledEvent -> String)
-> ([CreateScheduledEvent] -> ShowS)
-> Show CreateScheduledEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateScheduledEvent -> ShowS
showsPrec :: Int -> CreateScheduledEvent -> ShowS
$cshow :: CreateScheduledEvent -> String
show :: CreateScheduledEvent -> String
$cshowList :: [CreateScheduledEvent] -> ShowS
showList :: [CreateScheduledEvent] -> ShowS
Show, CreateScheduledEvent -> CreateScheduledEvent -> Bool
(CreateScheduledEvent -> CreateScheduledEvent -> Bool)
-> (CreateScheduledEvent -> CreateScheduledEvent -> Bool)
-> Eq CreateScheduledEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateScheduledEvent -> CreateScheduledEvent -> Bool
== :: CreateScheduledEvent -> CreateScheduledEvent -> Bool
$c/= :: CreateScheduledEvent -> CreateScheduledEvent -> Bool
/= :: CreateScheduledEvent -> CreateScheduledEvent -> Bool
Eq, (forall x. CreateScheduledEvent -> Rep CreateScheduledEvent x)
-> (forall x. Rep CreateScheduledEvent x -> CreateScheduledEvent)
-> Generic CreateScheduledEvent
forall x. Rep CreateScheduledEvent x -> CreateScheduledEvent
forall x. CreateScheduledEvent -> Rep CreateScheduledEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateScheduledEvent -> Rep CreateScheduledEvent x
from :: forall x. CreateScheduledEvent -> Rep CreateScheduledEvent x
$cto :: forall x. Rep CreateScheduledEvent x -> CreateScheduledEvent
to :: forall x. Rep CreateScheduledEvent x -> CreateScheduledEvent
Generic)

instance FromJSON CreateScheduledEvent where
  parseJSON :: Value -> Parser CreateScheduledEvent
parseJSON =
    String
-> (Object -> Parser CreateScheduledEvent)
-> Value
-> Parser CreateScheduledEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateScheduledEvent" ((Object -> Parser CreateScheduledEvent)
 -> Value -> Parser CreateScheduledEvent)
-> (Object -> Parser CreateScheduledEvent)
-> Value
-> Parser CreateScheduledEvent
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      InputWebhook
-> UTCTime
-> Maybe Value
-> [HeaderConf]
-> STRetryConf
-> Maybe Text
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> CreateScheduledEvent
CreateScheduledEvent
        (InputWebhook
 -> UTCTime
 -> Maybe Value
 -> [HeaderConf]
 -> STRetryConf
 -> Maybe Text
 -> Maybe RequestTransform
 -> Maybe MetadataResponseTransform
 -> CreateScheduledEvent)
-> Parser InputWebhook
-> Parser
     (UTCTime
      -> Maybe Value
      -> [HeaderConf]
      -> STRetryConf
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CreateScheduledEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
        Object -> Key -> Parser InputWebhook
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"webhook"
        Parser
  (UTCTime
   -> Maybe Value
   -> [HeaderConf]
   -> STRetryConf
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CreateScheduledEvent)
-> Parser UTCTime
-> Parser
     (Maybe Value
      -> [HeaderConf]
      -> STRetryConf
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CreateScheduledEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schedule_at"
        Parser
  (Maybe Value
   -> [HeaderConf]
   -> STRetryConf
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CreateScheduledEvent)
-> Parser (Maybe Value)
-> Parser
     ([HeaderConf]
      -> STRetryConf
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CreateScheduledEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload"
        Parser
  ([HeaderConf]
   -> STRetryConf
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CreateScheduledEvent)
-> Parser [HeaderConf]
-> Parser
     (STRetryConf
      -> Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CreateScheduledEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser (Maybe [HeaderConf])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers"
        Parser (Maybe [HeaderConf]) -> [HeaderConf] -> Parser [HeaderConf]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
        Parser
  (STRetryConf
   -> Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CreateScheduledEvent)
-> Parser STRetryConf
-> Parser
     (Maybe Text
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> CreateScheduledEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser (Maybe STRetryConf)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"retry_conf"
        Parser (Maybe STRetryConf) -> STRetryConf -> Parser STRetryConf
forall a. Parser (Maybe a) -> a -> Parser a
.!= STRetryConf
defaultSTRetryConf
        Parser
  (Maybe Text
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> CreateScheduledEvent)
-> Parser (Maybe Text)
-> Parser
     (Maybe RequestTransform
      -> Maybe MetadataResponseTransform -> CreateScheduledEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"
        Parser
  (Maybe RequestTransform
   -> Maybe MetadataResponseTransform -> CreateScheduledEvent)
-> Parser (Maybe RequestTransform)
-> Parser (Maybe MetadataResponseTransform -> CreateScheduledEvent)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser (Maybe RequestTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_transform"
        Parser (Maybe MetadataResponseTransform -> CreateScheduledEvent)
-> Parser (Maybe MetadataResponseTransform)
-> Parser CreateScheduledEvent
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser (Maybe MetadataResponseTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_transform"

instance ToJSON CreateScheduledEvent where
  toJSON :: CreateScheduledEvent -> Value
toJSON = Options -> CreateScheduledEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: CreateScheduledEvent -> Encoding
toEncoding = Options -> CreateScheduledEvent -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

-- | The 'ScheduledEventType' data type is needed to differentiate
--   between a 'CronScheduledEvent' and 'OneOffScheduledEvent' scheduled
--   event because they both have different configurations
--   and they live in different tables.
data ScheduledEventType
  = -- | A Cron scheduled event has a template defined which will
    -- contain the webhook, header configuration, retry
    -- configuration and a payload. Every cron event created
    -- uses the above mentioned configurations defined in the template.
    -- The configuration defined with the cron trigger is cached
    -- and hence it's not fetched along the cron scheduled events.
    Cron
  | -- | A One-off scheduled event doesn't have any template defined
    -- so all the configuration is fetched along the scheduled events.
    OneOff
  deriving stock (ScheduledEventType -> ScheduledEventType -> Bool
(ScheduledEventType -> ScheduledEventType -> Bool)
-> (ScheduledEventType -> ScheduledEventType -> Bool)
-> Eq ScheduledEventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduledEventType -> ScheduledEventType -> Bool
== :: ScheduledEventType -> ScheduledEventType -> Bool
$c/= :: ScheduledEventType -> ScheduledEventType -> Bool
/= :: ScheduledEventType -> ScheduledEventType -> Bool
Eq, Int -> ScheduledEventType -> ShowS
[ScheduledEventType] -> ShowS
ScheduledEventType -> String
(Int -> ScheduledEventType -> ShowS)
-> (ScheduledEventType -> String)
-> ([ScheduledEventType] -> ShowS)
-> Show ScheduledEventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduledEventType -> ShowS
showsPrec :: Int -> ScheduledEventType -> ShowS
$cshow :: ScheduledEventType -> String
show :: ScheduledEventType -> String
$cshowList :: [ScheduledEventType] -> ShowS
showList :: [ScheduledEventType] -> ShowS
Show, (forall x. ScheduledEventType -> Rep ScheduledEventType x)
-> (forall x. Rep ScheduledEventType x -> ScheduledEventType)
-> Generic ScheduledEventType
forall x. Rep ScheduledEventType x -> ScheduledEventType
forall x. ScheduledEventType -> Rep ScheduledEventType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduledEventType -> Rep ScheduledEventType x
from :: forall x. ScheduledEventType -> Rep ScheduledEventType x
$cto :: forall x. Rep ScheduledEventType x -> ScheduledEventType
to :: forall x. Rep ScheduledEventType x -> ScheduledEventType
Generic)

instance FromJSON ScheduledEventType where
  parseJSON :: Value -> Parser ScheduledEventType
parseJSON = Options -> Value -> Parser ScheduledEventType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase}

instance ToJSON ScheduledEventType where
  toJSON :: ScheduledEventType -> Value
toJSON = Options -> ScheduledEventType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase}
  toEncoding :: ScheduledEventType -> Encoding
toEncoding = Options -> ScheduledEventType -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase}

data ScheduledEventInvocation = ScheduledEventInvocation
  { ScheduledEventInvocation -> Text
_seiId :: InvocationId,
    ScheduledEventInvocation -> EventId
_seiEventId :: EventId,
    ScheduledEventInvocation -> Maybe Int
_seiStatus :: Maybe Int,
    ScheduledEventInvocation -> Maybe Value
_seiRequest :: Maybe Value,
    ScheduledEventInvocation -> Maybe Value
_seiResponse :: Maybe Value,
    ScheduledEventInvocation -> UTCTime
_seiCreatedAt :: UTCTime
  }
  deriving stock (Int -> ScheduledEventInvocation -> ShowS
[ScheduledEventInvocation] -> ShowS
ScheduledEventInvocation -> String
(Int -> ScheduledEventInvocation -> ShowS)
-> (ScheduledEventInvocation -> String)
-> ([ScheduledEventInvocation] -> ShowS)
-> Show ScheduledEventInvocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduledEventInvocation -> ShowS
showsPrec :: Int -> ScheduledEventInvocation -> ShowS
$cshow :: ScheduledEventInvocation -> String
show :: ScheduledEventInvocation -> String
$cshowList :: [ScheduledEventInvocation] -> ShowS
showList :: [ScheduledEventInvocation] -> ShowS
Show, ScheduledEventInvocation -> ScheduledEventInvocation -> Bool
(ScheduledEventInvocation -> ScheduledEventInvocation -> Bool)
-> (ScheduledEventInvocation -> ScheduledEventInvocation -> Bool)
-> Eq ScheduledEventInvocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduledEventInvocation -> ScheduledEventInvocation -> Bool
== :: ScheduledEventInvocation -> ScheduledEventInvocation -> Bool
$c/= :: ScheduledEventInvocation -> ScheduledEventInvocation -> Bool
/= :: ScheduledEventInvocation -> ScheduledEventInvocation -> Bool
Eq, (forall x.
 ScheduledEventInvocation -> Rep ScheduledEventInvocation x)
-> (forall x.
    Rep ScheduledEventInvocation x -> ScheduledEventInvocation)
-> Generic ScheduledEventInvocation
forall x.
Rep ScheduledEventInvocation x -> ScheduledEventInvocation
forall x.
ScheduledEventInvocation -> Rep ScheduledEventInvocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ScheduledEventInvocation -> Rep ScheduledEventInvocation x
from :: forall x.
ScheduledEventInvocation -> Rep ScheduledEventInvocation x
$cto :: forall x.
Rep ScheduledEventInvocation x -> ScheduledEventInvocation
to :: forall x.
Rep ScheduledEventInvocation x -> ScheduledEventInvocation
Generic)

instance FromJSON ScheduledEventInvocation where
  parseJSON :: Value -> Parser ScheduledEventInvocation
parseJSON = Options -> Value -> Parser ScheduledEventInvocation
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON ScheduledEventInvocation where
  toJSON :: ScheduledEventInvocation -> Value
toJSON = Options -> ScheduledEventInvocation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: ScheduledEventInvocation -> Encoding
toEncoding = Options -> ScheduledEventInvocation -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data ScheduledEvent
  = SEOneOff
  | SECron TriggerName
  deriving (Int -> ScheduledEvent -> ShowS
[ScheduledEvent] -> ShowS
ScheduledEvent -> String
(Int -> ScheduledEvent -> ShowS)
-> (ScheduledEvent -> String)
-> ([ScheduledEvent] -> ShowS)
-> Show ScheduledEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduledEvent -> ShowS
showsPrec :: Int -> ScheduledEvent -> ShowS
$cshow :: ScheduledEvent -> String
show :: ScheduledEvent -> String
$cshowList :: [ScheduledEvent] -> ShowS
showList :: [ScheduledEvent] -> ShowS
Show, ScheduledEvent -> ScheduledEvent -> Bool
(ScheduledEvent -> ScheduledEvent -> Bool)
-> (ScheduledEvent -> ScheduledEvent -> Bool) -> Eq ScheduledEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduledEvent -> ScheduledEvent -> Bool
== :: ScheduledEvent -> ScheduledEvent -> Bool
$c/= :: ScheduledEvent -> ScheduledEvent -> Bool
/= :: ScheduledEvent -> ScheduledEvent -> Bool
Eq)

parseScheduledEvent :: Object -> Parser ScheduledEvent
parseScheduledEvent :: Object -> Parser ScheduledEvent
parseScheduledEvent Object
o = do
  ScheduledEventType
ty <- Object
o Object -> Key -> Parser ScheduledEventType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
  case ScheduledEventType
ty of
    ScheduledEventType
Cron -> TriggerName -> ScheduledEvent
SECron (TriggerName -> ScheduledEvent)
-> Parser TriggerName -> Parser ScheduledEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TriggerName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"trigger_name"
    ScheduledEventType
OneOff -> ScheduledEvent -> Parser ScheduledEvent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScheduledEvent
SEOneOff

scheduledEventToPairs :: ScheduledEvent -> [Pair]
scheduledEventToPairs :: ScheduledEvent -> [Pair]
scheduledEventToPairs = \case
  ScheduledEvent
SEOneOff -> [Key
"type" Key -> ScheduledEventType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ScheduledEventType
OneOff]
  SECron TriggerName
name -> [Key
"type" Key -> ScheduledEventType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ScheduledEventType
Cron, Key
"trigger_name" Key -> TriggerName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TriggerName
name]

data CronEventSeed = CronEventSeed
  { CronEventSeed -> TriggerName
cesName :: TriggerName,
    CronEventSeed -> UTCTime
cesScheduledTime :: UTCTime
  }
  deriving (Int -> CronEventSeed -> ShowS
[CronEventSeed] -> ShowS
CronEventSeed -> String
(Int -> CronEventSeed -> ShowS)
-> (CronEventSeed -> String)
-> ([CronEventSeed] -> ShowS)
-> Show CronEventSeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronEventSeed -> ShowS
showsPrec :: Int -> CronEventSeed -> ShowS
$cshow :: CronEventSeed -> String
show :: CronEventSeed -> String
$cshowList :: [CronEventSeed] -> ShowS
showList :: [CronEventSeed] -> ShowS
Show, CronEventSeed -> CronEventSeed -> Bool
(CronEventSeed -> CronEventSeed -> Bool)
-> (CronEventSeed -> CronEventSeed -> Bool) -> Eq CronEventSeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronEventSeed -> CronEventSeed -> Bool
== :: CronEventSeed -> CronEventSeed -> Bool
$c/= :: CronEventSeed -> CronEventSeed -> Bool
/= :: CronEventSeed -> CronEventSeed -> Bool
Eq)

type OneOffEvent = CreateScheduledEvent

data ScheduledEventStatus
  = SESScheduled
  | SESLocked
  | SESDelivered
  | SESError
  | SESDead
  deriving (Int -> ScheduledEventStatus -> ShowS
[ScheduledEventStatus] -> ShowS
ScheduledEventStatus -> String
(Int -> ScheduledEventStatus -> ShowS)
-> (ScheduledEventStatus -> String)
-> ([ScheduledEventStatus] -> ShowS)
-> Show ScheduledEventStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduledEventStatus -> ShowS
showsPrec :: Int -> ScheduledEventStatus -> ShowS
$cshow :: ScheduledEventStatus -> String
show :: ScheduledEventStatus -> String
$cshowList :: [ScheduledEventStatus] -> ShowS
showList :: [ScheduledEventStatus] -> ShowS
Show, ScheduledEventStatus -> ScheduledEventStatus -> Bool
(ScheduledEventStatus -> ScheduledEventStatus -> Bool)
-> (ScheduledEventStatus -> ScheduledEventStatus -> Bool)
-> Eq ScheduledEventStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduledEventStatus -> ScheduledEventStatus -> Bool
== :: ScheduledEventStatus -> ScheduledEventStatus -> Bool
$c/= :: ScheduledEventStatus -> ScheduledEventStatus -> Bool
/= :: ScheduledEventStatus -> ScheduledEventStatus -> Bool
Eq)

scheduledEventStatusToText :: ScheduledEventStatus -> Text
scheduledEventStatusToText :: ScheduledEventStatus -> Text
scheduledEventStatusToText ScheduledEventStatus
SESScheduled = Text
"scheduled"
scheduledEventStatusToText ScheduledEventStatus
SESLocked = Text
"locked"
scheduledEventStatusToText ScheduledEventStatus
SESDelivered = Text
"delivered"
scheduledEventStatusToText ScheduledEventStatus
SESError = Text
"error"
scheduledEventStatusToText ScheduledEventStatus
SESDead = Text
"dead"

textToScheduledEventStatus :: Text -> Maybe ScheduledEventStatus
textToScheduledEventStatus :: Text -> Maybe ScheduledEventStatus
textToScheduledEventStatus = \case
  Text
"scheduled" -> ScheduledEventStatus -> Maybe ScheduledEventStatus
forall a. a -> Maybe a
Just ScheduledEventStatus
SESScheduled
  Text
"locked" -> ScheduledEventStatus -> Maybe ScheduledEventStatus
forall a. a -> Maybe a
Just ScheduledEventStatus
SESLocked
  Text
"delivered" -> ScheduledEventStatus -> Maybe ScheduledEventStatus
forall a. a -> Maybe a
Just ScheduledEventStatus
SESDelivered
  Text
"error" -> ScheduledEventStatus -> Maybe ScheduledEventStatus
forall a. a -> Maybe a
Just ScheduledEventStatus
SESError
  Text
"dead" -> ScheduledEventStatus -> Maybe ScheduledEventStatus
forall a. a -> Maybe a
Just ScheduledEventStatus
SESDead
  Text
_ -> Maybe ScheduledEventStatus
forall a. Maybe a
Nothing

instance PG.ToPrepArg ScheduledEventStatus where
  toPrepVal :: ScheduledEventStatus -> PrepArg
toPrepVal = Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal (Text -> PrepArg)
-> (ScheduledEventStatus -> Text)
-> ScheduledEventStatus
-> PrepArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScheduledEventStatus -> Text
scheduledEventStatusToText

instance PG.FromCol ScheduledEventStatus where
  fromCol :: Maybe ByteString -> Either Text ScheduledEventStatus
fromCol Maybe ByteString
bs =
    (Value ScheduledEventStatus
 -> Maybe ByteString -> Either Text ScheduledEventStatus)
-> Maybe ByteString
-> Value ScheduledEventStatus
-> Either Text ScheduledEventStatus
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value ScheduledEventStatus
-> Maybe ByteString -> Either Text ScheduledEventStatus
forall a. Value a -> Maybe ByteString -> Either Text a
PG.fromColHelper Maybe ByteString
bs (Value ScheduledEventStatus -> Either Text ScheduledEventStatus)
-> Value ScheduledEventStatus -> Either Text ScheduledEventStatus
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe ScheduledEventStatus) -> Value ScheduledEventStatus
forall a. (Text -> Maybe a) -> Value a
PD.enum Text -> Maybe ScheduledEventStatus
textToScheduledEventStatus

instance ToJSON ScheduledEventStatus where
  toJSON :: ScheduledEventStatus -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (ScheduledEventStatus -> Text) -> ScheduledEventStatus -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScheduledEventStatus -> Text
scheduledEventStatusToText

instance FromJSON ScheduledEventStatus where
  parseJSON :: Value -> Parser ScheduledEventStatus
parseJSON = String
-> (Text -> Parser ScheduledEventStatus)
-> Value
-> Parser ScheduledEventStatus
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"String" ((Text -> Parser ScheduledEventStatus)
 -> Value -> Parser ScheduledEventStatus)
-> (Text -> Parser ScheduledEventStatus)
-> Value
-> Parser ScheduledEventStatus
forall a b. (a -> b) -> a -> b
$ \Text
s ->
    Maybe ScheduledEventStatus
-> Parser ScheduledEventStatus -> Parser ScheduledEventStatus
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> Maybe ScheduledEventStatus
textToScheduledEventStatus Text
s)
      (Parser ScheduledEventStatus -> Parser ScheduledEventStatus)
-> Parser ScheduledEventStatus -> Parser ScheduledEventStatus
forall a b. (a -> b) -> a -> b
$ String -> Parser ScheduledEventStatus
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      (String -> Parser ScheduledEventStatus)
-> String -> Parser ScheduledEventStatus
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack
      (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"unexpected status: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

data OneOffScheduledEvent = OneOffScheduledEvent
  { OneOffScheduledEvent -> EventId
_ooseId :: OneOffScheduledEventId,
    OneOffScheduledEvent -> InputWebhook
_ooseWebhookConf :: InputWebhook,
    OneOffScheduledEvent -> UTCTime
_ooseScheduledTime :: UTCTime,
    OneOffScheduledEvent -> STRetryConf
_ooseRetryConf :: STRetryConf,
    OneOffScheduledEvent -> Maybe Value
_oosePayload :: Maybe Value,
    OneOffScheduledEvent -> [HeaderConf]
_ooseHeaderConf :: [HeaderConf],
    OneOffScheduledEvent -> Text
_ooseStatus :: Text,
    OneOffScheduledEvent -> Int
_ooseTries :: Int,
    OneOffScheduledEvent -> UTCTime
_ooseCreatedAt :: UTCTime,
    OneOffScheduledEvent -> Maybe UTCTime
_ooseNextRetryAt :: Maybe UTCTime,
    OneOffScheduledEvent -> Maybe Text
_ooseComment :: Maybe Text,
    OneOffScheduledEvent -> Maybe RequestTransform
_ooseRequestTransform :: Maybe RequestTransform,
    OneOffScheduledEvent -> Maybe MetadataResponseTransform
_ooseResponseTransform :: Maybe MetadataResponseTransform
  }
  deriving stock (Int -> OneOffScheduledEvent -> ShowS
[OneOffScheduledEvent] -> ShowS
OneOffScheduledEvent -> String
(Int -> OneOffScheduledEvent -> ShowS)
-> (OneOffScheduledEvent -> String)
-> ([OneOffScheduledEvent] -> ShowS)
-> Show OneOffScheduledEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneOffScheduledEvent -> ShowS
showsPrec :: Int -> OneOffScheduledEvent -> ShowS
$cshow :: OneOffScheduledEvent -> String
show :: OneOffScheduledEvent -> String
$cshowList :: [OneOffScheduledEvent] -> ShowS
showList :: [OneOffScheduledEvent] -> ShowS
Show, OneOffScheduledEvent -> OneOffScheduledEvent -> Bool
(OneOffScheduledEvent -> OneOffScheduledEvent -> Bool)
-> (OneOffScheduledEvent -> OneOffScheduledEvent -> Bool)
-> Eq OneOffScheduledEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OneOffScheduledEvent -> OneOffScheduledEvent -> Bool
== :: OneOffScheduledEvent -> OneOffScheduledEvent -> Bool
$c/= :: OneOffScheduledEvent -> OneOffScheduledEvent -> Bool
/= :: OneOffScheduledEvent -> OneOffScheduledEvent -> Bool
Eq, (forall x. OneOffScheduledEvent -> Rep OneOffScheduledEvent x)
-> (forall x. Rep OneOffScheduledEvent x -> OneOffScheduledEvent)
-> Generic OneOffScheduledEvent
forall x. Rep OneOffScheduledEvent x -> OneOffScheduledEvent
forall x. OneOffScheduledEvent -> Rep OneOffScheduledEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OneOffScheduledEvent -> Rep OneOffScheduledEvent x
from :: forall x. OneOffScheduledEvent -> Rep OneOffScheduledEvent x
$cto :: forall x. Rep OneOffScheduledEvent x -> OneOffScheduledEvent
to :: forall x. Rep OneOffScheduledEvent x -> OneOffScheduledEvent
Generic)

instance FromJSON OneOffScheduledEvent where
  parseJSON :: Value -> Parser OneOffScheduledEvent
parseJSON = Options -> Value -> Parser OneOffScheduledEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON OneOffScheduledEvent where
  toJSON :: OneOffScheduledEvent -> Value
toJSON = Options -> OneOffScheduledEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: OneOffScheduledEvent -> Encoding
toEncoding = Options -> OneOffScheduledEvent -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data CronEvent = CronEvent
  { CronEvent -> EventId
_ceId :: CronEventId,
    CronEvent -> TriggerName
_ceTriggerName :: TriggerName,
    -- | We expect this to always be at second zero, since cron events have
    -- minute resolution. Note that a OneOffScheduledEvent has full timestamp
    -- precision.
    CronEvent -> UTCTime
_ceScheduledTime :: UTCTime,
    CronEvent -> Text
_ceStatus :: Text,
    CronEvent -> Int
_ceTries :: Int,
    -- | it is the time at which the cron event generator created the event
    CronEvent -> UTCTime
_ceCreatedAt :: UTCTime,
    CronEvent -> Maybe UTCTime
_ceNextRetryAt :: Maybe UTCTime
  }
  deriving stock (Int -> CronEvent -> ShowS
[CronEvent] -> ShowS
CronEvent -> String
(Int -> CronEvent -> ShowS)
-> (CronEvent -> String)
-> ([CronEvent] -> ShowS)
-> Show CronEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronEvent -> ShowS
showsPrec :: Int -> CronEvent -> ShowS
$cshow :: CronEvent -> String
show :: CronEvent -> String
$cshowList :: [CronEvent] -> ShowS
showList :: [CronEvent] -> ShowS
Show, CronEvent -> CronEvent -> Bool
(CronEvent -> CronEvent -> Bool)
-> (CronEvent -> CronEvent -> Bool) -> Eq CronEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronEvent -> CronEvent -> Bool
== :: CronEvent -> CronEvent -> Bool
$c/= :: CronEvent -> CronEvent -> Bool
/= :: CronEvent -> CronEvent -> Bool
Eq, (forall x. CronEvent -> Rep CronEvent x)
-> (forall x. Rep CronEvent x -> CronEvent) -> Generic CronEvent
forall x. Rep CronEvent x -> CronEvent
forall x. CronEvent -> Rep CronEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CronEvent -> Rep CronEvent x
from :: forall x. CronEvent -> Rep CronEvent x
$cto :: forall x. Rep CronEvent x -> CronEvent
to :: forall x. Rep CronEvent x -> CronEvent
Generic)

instance FromJSON CronEvent where
  parseJSON :: Value -> Parser CronEvent
parseJSON = Options -> Value -> Parser CronEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON CronEvent where
  toJSON :: CronEvent -> Value
toJSON = Options -> CronEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: CronEvent -> Encoding
toEncoding = Options -> CronEvent -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data ScheduledEventPagination = ScheduledEventPagination
  { ScheduledEventPagination -> Maybe Int
_sepLimit :: Maybe Int,
    ScheduledEventPagination -> Maybe Int
_sepOffset :: Maybe Int
  }
  deriving (Int -> ScheduledEventPagination -> ShowS
[ScheduledEventPagination] -> ShowS
ScheduledEventPagination -> String
(Int -> ScheduledEventPagination -> ShowS)
-> (ScheduledEventPagination -> String)
-> ([ScheduledEventPagination] -> ShowS)
-> Show ScheduledEventPagination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduledEventPagination -> ShowS
showsPrec :: Int -> ScheduledEventPagination -> ShowS
$cshow :: ScheduledEventPagination -> String
show :: ScheduledEventPagination -> String
$cshowList :: [ScheduledEventPagination] -> ShowS
showList :: [ScheduledEventPagination] -> ShowS
Show, ScheduledEventPagination -> ScheduledEventPagination -> Bool
(ScheduledEventPagination -> ScheduledEventPagination -> Bool)
-> (ScheduledEventPagination -> ScheduledEventPagination -> Bool)
-> Eq ScheduledEventPagination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduledEventPagination -> ScheduledEventPagination -> Bool
== :: ScheduledEventPagination -> ScheduledEventPagination -> Bool
$c/= :: ScheduledEventPagination -> ScheduledEventPagination -> Bool
/= :: ScheduledEventPagination -> ScheduledEventPagination -> Bool
Eq)

parseScheduledEventPagination :: Object -> Parser ScheduledEventPagination
parseScheduledEventPagination :: Object -> Parser ScheduledEventPagination
parseScheduledEventPagination Object
o =
  Maybe Int -> Maybe Int -> ScheduledEventPagination
ScheduledEventPagination
    (Maybe Int -> Maybe Int -> ScheduledEventPagination)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> ScheduledEventPagination)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
    Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"limit"
    Parser (Maybe Int -> ScheduledEventPagination)
-> Parser (Maybe Int) -> Parser ScheduledEventPagination
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
    Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"offset"

scheduledEventPaginationToPairs :: ScheduledEventPagination -> [Pair]
scheduledEventPaginationToPairs :: ScheduledEventPagination -> [Pair]
scheduledEventPaginationToPairs ScheduledEventPagination {Maybe Int
_sepLimit :: ScheduledEventPagination -> Maybe Int
_sepOffset :: ScheduledEventPagination -> Maybe Int
_sepLimit :: Maybe Int
_sepOffset :: Maybe Int
..} =
  [Key
"limit" Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Int
_sepLimit, Key
"offset" Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Int
_sepOffset]

data RowsCountOption = IncludeRowsCount | DontIncludeRowsCount
  deriving (Int -> RowsCountOption -> ShowS
[RowsCountOption] -> ShowS
RowsCountOption -> String
(Int -> RowsCountOption -> ShowS)
-> (RowsCountOption -> String)
-> ([RowsCountOption] -> ShowS)
-> Show RowsCountOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowsCountOption -> ShowS
showsPrec :: Int -> RowsCountOption -> ShowS
$cshow :: RowsCountOption -> String
show :: RowsCountOption -> String
$cshowList :: [RowsCountOption] -> ShowS
showList :: [RowsCountOption] -> ShowS
Show, RowsCountOption -> RowsCountOption -> Bool
(RowsCountOption -> RowsCountOption -> Bool)
-> (RowsCountOption -> RowsCountOption -> Bool)
-> Eq RowsCountOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowsCountOption -> RowsCountOption -> Bool
== :: RowsCountOption -> RowsCountOption -> Bool
$c/= :: RowsCountOption -> RowsCountOption -> Bool
/= :: RowsCountOption -> RowsCountOption -> Bool
Eq)

instance FromJSON RowsCountOption where
  parseJSON :: Value -> Parser RowsCountOption
parseJSON = String
-> (Bool -> Parser RowsCountOption)
-> Value
-> Parser RowsCountOption
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
"RowsCountOption" ((Bool -> Parser RowsCountOption)
 -> Value -> Parser RowsCountOption)
-> (Bool -> Parser RowsCountOption)
-> Value
-> Parser RowsCountOption
forall a b. (a -> b) -> a -> b
$ RowsCountOption -> Parser RowsCountOption
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowsCountOption -> Parser RowsCountOption)
-> (Bool -> RowsCountOption) -> Bool -> Parser RowsCountOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowsCountOption -> RowsCountOption -> Bool -> RowsCountOption
forall a. a -> a -> Bool -> a
bool RowsCountOption
DontIncludeRowsCount RowsCountOption
IncludeRowsCount

instance ToJSON RowsCountOption where
  toJSON :: RowsCountOption -> Value
toJSON = Bool -> Value
Bool (Bool -> Value)
-> (RowsCountOption -> Bool) -> RowsCountOption -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RowsCountOption -> RowsCountOption -> Bool
forall a. Eq a => a -> a -> Bool
== RowsCountOption
IncludeRowsCount)

-- | Query type to fetch all one-off/cron scheduled events
data GetScheduledEvents = GetScheduledEvents
  { GetScheduledEvents -> ScheduledEvent
_gseScheduledEvent :: ScheduledEvent,
    GetScheduledEvents -> ScheduledEventPagination
_gsePagination :: ScheduledEventPagination,
    GetScheduledEvents -> [ScheduledEventStatus]
_gseStatus :: [ScheduledEventStatus],
    GetScheduledEvents -> RowsCountOption
_gseGetRowsCount :: RowsCountOption
  }
  deriving (Int -> GetScheduledEvents -> ShowS
[GetScheduledEvents] -> ShowS
GetScheduledEvents -> String
(Int -> GetScheduledEvents -> ShowS)
-> (GetScheduledEvents -> String)
-> ([GetScheduledEvents] -> ShowS)
-> Show GetScheduledEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetScheduledEvents -> ShowS
showsPrec :: Int -> GetScheduledEvents -> ShowS
$cshow :: GetScheduledEvents -> String
show :: GetScheduledEvents -> String
$cshowList :: [GetScheduledEvents] -> ShowS
showList :: [GetScheduledEvents] -> ShowS
Show, GetScheduledEvents -> GetScheduledEvents -> Bool
(GetScheduledEvents -> GetScheduledEvents -> Bool)
-> (GetScheduledEvents -> GetScheduledEvents -> Bool)
-> Eq GetScheduledEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetScheduledEvents -> GetScheduledEvents -> Bool
== :: GetScheduledEvents -> GetScheduledEvents -> Bool
$c/= :: GetScheduledEvents -> GetScheduledEvents -> Bool
/= :: GetScheduledEvents -> GetScheduledEvents -> Bool
Eq)

instance ToJSON GetScheduledEvents where
  toJSON :: GetScheduledEvents -> Value
toJSON GetScheduledEvents {[ScheduledEventStatus]
RowsCountOption
ScheduledEventPagination
ScheduledEvent
_gseScheduledEvent :: GetScheduledEvents -> ScheduledEvent
_gsePagination :: GetScheduledEvents -> ScheduledEventPagination
_gseStatus :: GetScheduledEvents -> [ScheduledEventStatus]
_gseGetRowsCount :: GetScheduledEvents -> RowsCountOption
_gseScheduledEvent :: ScheduledEvent
_gsePagination :: ScheduledEventPagination
_gseStatus :: [ScheduledEventStatus]
_gseGetRowsCount :: RowsCountOption
..} =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ScheduledEvent -> [Pair]
scheduledEventToPairs ScheduledEvent
_gseScheduledEvent
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> ScheduledEventPagination -> [Pair]
scheduledEventPaginationToPairs ScheduledEventPagination
_gsePagination
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"status" Key -> [ScheduledEventStatus] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [ScheduledEventStatus]
_gseStatus,
           Key
"get_rows_count" Key -> RowsCountOption -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RowsCountOption
_gseGetRowsCount
         ]

instance FromJSON GetScheduledEvents where
  parseJSON :: Value -> Parser GetScheduledEvents
parseJSON = String
-> (Object -> Parser GetScheduledEvents)
-> Value
-> Parser GetScheduledEvents
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GetScheduledEvents" ((Object -> Parser GetScheduledEvents)
 -> Value -> Parser GetScheduledEvents)
-> (Object -> Parser GetScheduledEvents)
-> Value
-> Parser GetScheduledEvents
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ScheduledEvent
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> GetScheduledEvents
GetScheduledEvents
      (ScheduledEvent
 -> ScheduledEventPagination
 -> [ScheduledEventStatus]
 -> RowsCountOption
 -> GetScheduledEvents)
-> Parser ScheduledEvent
-> Parser
     (ScheduledEventPagination
      -> [ScheduledEventStatus] -> RowsCountOption -> GetScheduledEvents)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ScheduledEvent
parseScheduledEvent Object
o
      Parser
  (ScheduledEventPagination
   -> [ScheduledEventStatus] -> RowsCountOption -> GetScheduledEvents)
-> Parser ScheduledEventPagination
-> Parser
     ([ScheduledEventStatus] -> RowsCountOption -> GetScheduledEvents)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser ScheduledEventPagination
parseScheduledEventPagination Object
o
      Parser
  ([ScheduledEventStatus] -> RowsCountOption -> GetScheduledEvents)
-> Parser [ScheduledEventStatus]
-> Parser (RowsCountOption -> GetScheduledEvents)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe [ScheduledEventStatus])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status"
      Parser (Maybe [ScheduledEventStatus])
-> [ScheduledEventStatus] -> Parser [ScheduledEventStatus]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser (RowsCountOption -> GetScheduledEvents)
-> Parser RowsCountOption -> Parser GetScheduledEvents
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe RowsCountOption)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"get_rows_count"
      Parser (Maybe RowsCountOption)
-> RowsCountOption -> Parser RowsCountOption
forall a. Parser (Maybe a) -> a -> Parser a
.!= RowsCountOption
DontIncludeRowsCount

data WithOptionalTotalCount a = WithOptionalTotalCount
  { forall a. WithOptionalTotalCount a -> Maybe Int
_wtcCount :: Maybe Int,
    forall a. WithOptionalTotalCount a -> a
_wtcData :: a
  }
  deriving (Int -> WithOptionalTotalCount a -> ShowS
[WithOptionalTotalCount a] -> ShowS
WithOptionalTotalCount a -> String
(Int -> WithOptionalTotalCount a -> ShowS)
-> (WithOptionalTotalCount a -> String)
-> ([WithOptionalTotalCount a] -> ShowS)
-> Show (WithOptionalTotalCount a)
forall a. Show a => Int -> WithOptionalTotalCount a -> ShowS
forall a. Show a => [WithOptionalTotalCount a] -> ShowS
forall a. Show a => WithOptionalTotalCount a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithOptionalTotalCount a -> ShowS
showsPrec :: Int -> WithOptionalTotalCount a -> ShowS
$cshow :: forall a. Show a => WithOptionalTotalCount a -> String
show :: WithOptionalTotalCount a -> String
$cshowList :: forall a. Show a => [WithOptionalTotalCount a] -> ShowS
showList :: [WithOptionalTotalCount a] -> ShowS
Show, WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool
(WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool)
-> (WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool)
-> Eq (WithOptionalTotalCount a)
forall a.
Eq a =>
WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool
== :: WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool
$c/= :: forall a.
Eq a =>
WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool
/= :: WithOptionalTotalCount a -> WithOptionalTotalCount a -> Bool
Eq)

-- | Query type to delete cron/one-off events.
data DeleteScheduledEvent = DeleteScheduledEvent
  { DeleteScheduledEvent -> ScheduledEventType
_dseType :: ScheduledEventType,
    DeleteScheduledEvent -> EventId
_dseEventId :: ScheduledEventId
  }
  deriving stock (Int -> DeleteScheduledEvent -> ShowS
[DeleteScheduledEvent] -> ShowS
DeleteScheduledEvent -> String
(Int -> DeleteScheduledEvent -> ShowS)
-> (DeleteScheduledEvent -> String)
-> ([DeleteScheduledEvent] -> ShowS)
-> Show DeleteScheduledEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteScheduledEvent -> ShowS
showsPrec :: Int -> DeleteScheduledEvent -> ShowS
$cshow :: DeleteScheduledEvent -> String
show :: DeleteScheduledEvent -> String
$cshowList :: [DeleteScheduledEvent] -> ShowS
showList :: [DeleteScheduledEvent] -> ShowS
Show, DeleteScheduledEvent -> DeleteScheduledEvent -> Bool
(DeleteScheduledEvent -> DeleteScheduledEvent -> Bool)
-> (DeleteScheduledEvent -> DeleteScheduledEvent -> Bool)
-> Eq DeleteScheduledEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteScheduledEvent -> DeleteScheduledEvent -> Bool
== :: DeleteScheduledEvent -> DeleteScheduledEvent -> Bool
$c/= :: DeleteScheduledEvent -> DeleteScheduledEvent -> Bool
/= :: DeleteScheduledEvent -> DeleteScheduledEvent -> Bool
Eq, (forall x. DeleteScheduledEvent -> Rep DeleteScheduledEvent x)
-> (forall x. Rep DeleteScheduledEvent x -> DeleteScheduledEvent)
-> Generic DeleteScheduledEvent
forall x. Rep DeleteScheduledEvent x -> DeleteScheduledEvent
forall x. DeleteScheduledEvent -> Rep DeleteScheduledEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteScheduledEvent -> Rep DeleteScheduledEvent x
from :: forall x. DeleteScheduledEvent -> Rep DeleteScheduledEvent x
$cto :: forall x. Rep DeleteScheduledEvent x -> DeleteScheduledEvent
to :: forall x. Rep DeleteScheduledEvent x -> DeleteScheduledEvent
Generic)

instance FromJSON DeleteScheduledEvent where
  parseJSON :: Value -> Parser DeleteScheduledEvent
parseJSON = Options -> Value -> Parser DeleteScheduledEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON DeleteScheduledEvent where
  toJSON :: DeleteScheduledEvent -> Value
toJSON = Options -> DeleteScheduledEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: DeleteScheduledEvent -> Encoding
toEncoding = Options -> DeleteScheduledEvent -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data GetScheduledEventInvocationsBy
  = GIBEventId EventId ScheduledEventType
  | GIBEvent ScheduledEvent
  deriving (Int -> GetScheduledEventInvocationsBy -> ShowS
[GetScheduledEventInvocationsBy] -> ShowS
GetScheduledEventInvocationsBy -> String
(Int -> GetScheduledEventInvocationsBy -> ShowS)
-> (GetScheduledEventInvocationsBy -> String)
-> ([GetScheduledEventInvocationsBy] -> ShowS)
-> Show GetScheduledEventInvocationsBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetScheduledEventInvocationsBy -> ShowS
showsPrec :: Int -> GetScheduledEventInvocationsBy -> ShowS
$cshow :: GetScheduledEventInvocationsBy -> String
show :: GetScheduledEventInvocationsBy -> String
$cshowList :: [GetScheduledEventInvocationsBy] -> ShowS
showList :: [GetScheduledEventInvocationsBy] -> ShowS
Show, GetScheduledEventInvocationsBy
-> GetScheduledEventInvocationsBy -> Bool
(GetScheduledEventInvocationsBy
 -> GetScheduledEventInvocationsBy -> Bool)
-> (GetScheduledEventInvocationsBy
    -> GetScheduledEventInvocationsBy -> Bool)
-> Eq GetScheduledEventInvocationsBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetScheduledEventInvocationsBy
-> GetScheduledEventInvocationsBy -> Bool
== :: GetScheduledEventInvocationsBy
-> GetScheduledEventInvocationsBy -> Bool
$c/= :: GetScheduledEventInvocationsBy
-> GetScheduledEventInvocationsBy -> Bool
/= :: GetScheduledEventInvocationsBy
-> GetScheduledEventInvocationsBy -> Bool
Eq)

data GetScheduledEventInvocations = GetScheduledEventInvocations
  { GetScheduledEventInvocations -> GetScheduledEventInvocationsBy
_geiInvocationsBy :: GetScheduledEventInvocationsBy,
    GetScheduledEventInvocations -> ScheduledEventPagination
_geiPagination :: ScheduledEventPagination,
    -- | Option to include the total rows corresponding in
    --   response.
    GetScheduledEventInvocations -> RowsCountOption
_geiGetRowsCount :: RowsCountOption
  }
  deriving (GetScheduledEventInvocations
-> GetScheduledEventInvocations -> Bool
(GetScheduledEventInvocations
 -> GetScheduledEventInvocations -> Bool)
-> (GetScheduledEventInvocations
    -> GetScheduledEventInvocations -> Bool)
-> Eq GetScheduledEventInvocations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetScheduledEventInvocations
-> GetScheduledEventInvocations -> Bool
== :: GetScheduledEventInvocations
-> GetScheduledEventInvocations -> Bool
$c/= :: GetScheduledEventInvocations
-> GetScheduledEventInvocations -> Bool
/= :: GetScheduledEventInvocations
-> GetScheduledEventInvocations -> Bool
Eq, Int -> GetScheduledEventInvocations -> ShowS
[GetScheduledEventInvocations] -> ShowS
GetScheduledEventInvocations -> String
(Int -> GetScheduledEventInvocations -> ShowS)
-> (GetScheduledEventInvocations -> String)
-> ([GetScheduledEventInvocations] -> ShowS)
-> Show GetScheduledEventInvocations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetScheduledEventInvocations -> ShowS
showsPrec :: Int -> GetScheduledEventInvocations -> ShowS
$cshow :: GetScheduledEventInvocations -> String
show :: GetScheduledEventInvocations -> String
$cshowList :: [GetScheduledEventInvocations] -> ShowS
showList :: [GetScheduledEventInvocations] -> ShowS
Show)

instance FromJSON GetScheduledEventInvocations where
  parseJSON :: Value -> Parser GetScheduledEventInvocations
parseJSON = String
-> (Object -> Parser GetScheduledEventInvocations)
-> Value
-> Parser GetScheduledEventInvocations
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GetScheduledEventInvocations" ((Object -> Parser GetScheduledEventInvocations)
 -> Value -> Parser GetScheduledEventInvocations)
-> (Object -> Parser GetScheduledEventInvocations)
-> Value
-> Parser GetScheduledEventInvocations
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    GetScheduledEventInvocationsBy
-> ScheduledEventPagination
-> RowsCountOption
-> GetScheduledEventInvocations
GetScheduledEventInvocations
      (GetScheduledEventInvocationsBy
 -> ScheduledEventPagination
 -> RowsCountOption
 -> GetScheduledEventInvocations)
-> Parser GetScheduledEventInvocationsBy
-> Parser
     (ScheduledEventPagination
      -> RowsCountOption -> GetScheduledEventInvocations)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser GetScheduledEventInvocationsBy
parseEventId Object
o Parser GetScheduledEventInvocationsBy
-> Parser GetScheduledEventInvocationsBy
-> Parser GetScheduledEventInvocationsBy
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ScheduledEvent -> GetScheduledEventInvocationsBy
GIBEvent (ScheduledEvent -> GetScheduledEventInvocationsBy)
-> Parser ScheduledEvent -> Parser GetScheduledEventInvocationsBy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ScheduledEvent
parseScheduledEvent Object
o))
      Parser
  (ScheduledEventPagination
   -> RowsCountOption -> GetScheduledEventInvocations)
-> Parser ScheduledEventPagination
-> Parser (RowsCountOption -> GetScheduledEventInvocations)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser ScheduledEventPagination
parseScheduledEventPagination Object
o
      Parser (RowsCountOption -> GetScheduledEventInvocations)
-> Parser RowsCountOption -> Parser GetScheduledEventInvocations
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe RowsCountOption)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"get_rows_count"
      Parser (Maybe RowsCountOption)
-> RowsCountOption -> Parser RowsCountOption
forall a. Parser (Maybe a) -> a -> Parser a
.!= RowsCountOption
DontIncludeRowsCount
    where
      parseEventId :: Object -> Parser GetScheduledEventInvocationsBy
parseEventId Object
o =
        EventId -> ScheduledEventType -> GetScheduledEventInvocationsBy
GIBEventId (EventId -> ScheduledEventType -> GetScheduledEventInvocationsBy)
-> Parser EventId
-> Parser (ScheduledEventType -> GetScheduledEventInvocationsBy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser EventId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event_id" Parser (ScheduledEventType -> GetScheduledEventInvocationsBy)
-> Parser ScheduledEventType
-> Parser GetScheduledEventInvocationsBy
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ScheduledEventType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

instance ToJSON GetScheduledEventInvocations where
  toJSON :: GetScheduledEventInvocations -> Value
toJSON GetScheduledEventInvocations {GetScheduledEventInvocationsBy
RowsCountOption
ScheduledEventPagination
_geiInvocationsBy :: GetScheduledEventInvocations -> GetScheduledEventInvocationsBy
_geiPagination :: GetScheduledEventInvocations -> ScheduledEventPagination
_geiGetRowsCount :: GetScheduledEventInvocations -> RowsCountOption
_geiInvocationsBy :: GetScheduledEventInvocationsBy
_geiPagination :: ScheduledEventPagination
_geiGetRowsCount :: RowsCountOption
..} =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ case GetScheduledEventInvocationsBy
_geiInvocationsBy of
        GIBEventId EventId
eventId ScheduledEventType
eventType -> [Key
"event_id" Key -> EventId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EventId
eventId, Key
"type" Key -> ScheduledEventType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ScheduledEventType
eventType]
        GIBEvent ScheduledEvent
event ->
          ScheduledEvent -> [Pair]
scheduledEventToPairs ScheduledEvent
event
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> ScheduledEventPagination -> [Pair]
scheduledEventPaginationToPairs ScheduledEventPagination
_geiPagination
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair] -> [Pair] -> Bool -> [Pair]
forall a. a -> a -> Bool -> a
bool [Pair]
forall a. Monoid a => a
mempty [Key
"get_rows_count" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True] (RowsCountOption
_geiGetRowsCount RowsCountOption -> RowsCountOption -> Bool
forall a. Eq a => a -> a -> Bool
== RowsCountOption
IncludeRowsCount)

data ClearCronEvents
  = -- | Used to delete the cron events only of the specified cron trigger
    SingleCronTrigger TriggerName
  | -- | Used to delete all the cron events of the cron triggers with `include_in_metadata: true`
    -- It is used in the case of the `replace_metadata` API
    MetadataCronTriggers [TriggerName]
  deriving (Int -> ClearCronEvents -> ShowS
[ClearCronEvents] -> ShowS
ClearCronEvents -> String
(Int -> ClearCronEvents -> ShowS)
-> (ClearCronEvents -> String)
-> ([ClearCronEvents] -> ShowS)
-> Show ClearCronEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClearCronEvents -> ShowS
showsPrec :: Int -> ClearCronEvents -> ShowS
$cshow :: ClearCronEvents -> String
show :: ClearCronEvents -> String
$cshowList :: [ClearCronEvents] -> ShowS
showList :: [ClearCronEvents] -> ShowS
Show, ClearCronEvents -> ClearCronEvents -> Bool
(ClearCronEvents -> ClearCronEvents -> Bool)
-> (ClearCronEvents -> ClearCronEvents -> Bool)
-> Eq ClearCronEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClearCronEvents -> ClearCronEvents -> Bool
== :: ClearCronEvents -> ClearCronEvents -> Bool
$c/= :: ClearCronEvents -> ClearCronEvents -> Bool
/= :: ClearCronEvents -> ClearCronEvents -> Bool
Eq)