module Stratosphere.Events.Rule.BatchParametersProperty (
        module Exports, BatchParametersProperty(..),
        mkBatchParametersProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Events.Rule.BatchArrayPropertiesProperty as Exports
import {-# SOURCE #-} Stratosphere.Events.Rule.BatchRetryStrategyProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data BatchParametersProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-events-rule-batchparameters.html>
    BatchParametersProperty {BatchParametersProperty -> ()
haddock_workaround_ :: (),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-events-rule-batchparameters.html#cfn-events-rule-batchparameters-arrayproperties>
                             BatchParametersProperty -> Maybe BatchArrayPropertiesProperty
arrayProperties :: (Prelude.Maybe BatchArrayPropertiesProperty),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-events-rule-batchparameters.html#cfn-events-rule-batchparameters-jobdefinition>
                             BatchParametersProperty -> Value Text
jobDefinition :: (Value Prelude.Text),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-events-rule-batchparameters.html#cfn-events-rule-batchparameters-jobname>
                             BatchParametersProperty -> Value Text
jobName :: (Value Prelude.Text),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-events-rule-batchparameters.html#cfn-events-rule-batchparameters-retrystrategy>
                             BatchParametersProperty -> Maybe BatchRetryStrategyProperty
retryStrategy :: (Prelude.Maybe BatchRetryStrategyProperty)}
  deriving stock (BatchParametersProperty -> BatchParametersProperty -> Bool
(BatchParametersProperty -> BatchParametersProperty -> Bool)
-> (BatchParametersProperty -> BatchParametersProperty -> Bool)
-> Eq BatchParametersProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BatchParametersProperty -> BatchParametersProperty -> Bool
== :: BatchParametersProperty -> BatchParametersProperty -> Bool
$c/= :: BatchParametersProperty -> BatchParametersProperty -> Bool
/= :: BatchParametersProperty -> BatchParametersProperty -> Bool
Prelude.Eq, Int -> BatchParametersProperty -> ShowS
[BatchParametersProperty] -> ShowS
BatchParametersProperty -> String
(Int -> BatchParametersProperty -> ShowS)
-> (BatchParametersProperty -> String)
-> ([BatchParametersProperty] -> ShowS)
-> Show BatchParametersProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatchParametersProperty -> ShowS
showsPrec :: Int -> BatchParametersProperty -> ShowS
$cshow :: BatchParametersProperty -> String
show :: BatchParametersProperty -> String
$cshowList :: [BatchParametersProperty] -> ShowS
showList :: [BatchParametersProperty] -> ShowS
Prelude.Show)
mkBatchParametersProperty ::
  Value Prelude.Text -> Value Prelude.Text -> BatchParametersProperty
mkBatchParametersProperty :: Value Text -> Value Text -> BatchParametersProperty
mkBatchParametersProperty Value Text
jobDefinition Value Text
jobName
  = BatchParametersProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), jobDefinition :: Value Text
jobDefinition = Value Text
jobDefinition,
       jobName :: Value Text
jobName = Value Text
jobName, arrayProperties :: Maybe BatchArrayPropertiesProperty
arrayProperties = Maybe BatchArrayPropertiesProperty
forall a. Maybe a
Prelude.Nothing,
       retryStrategy :: Maybe BatchRetryStrategyProperty
retryStrategy = Maybe BatchRetryStrategyProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties BatchParametersProperty where
  toResourceProperties :: BatchParametersProperty -> ResourceProperties
toResourceProperties BatchParametersProperty {Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: BatchParametersProperty -> ()
arrayProperties :: BatchParametersProperty -> Maybe BatchArrayPropertiesProperty
jobDefinition :: BatchParametersProperty -> Value Text
jobName :: BatchParametersProperty -> Value Text
retryStrategy :: BatchParametersProperty -> Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Events::Rule.BatchParameters",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"JobDefinition" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
jobDefinition, Key
"JobName" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
jobName]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> BatchArrayPropertiesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ArrayProperties" (BatchArrayPropertiesProperty -> (Key, Value))
-> Maybe BatchArrayPropertiesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BatchArrayPropertiesProperty
arrayProperties,
                               Key -> BatchRetryStrategyProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RetryStrategy" (BatchRetryStrategyProperty -> (Key, Value))
-> Maybe BatchRetryStrategyProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BatchRetryStrategyProperty
retryStrategy]))}
instance JSON.ToJSON BatchParametersProperty where
  toJSON :: BatchParametersProperty -> Value
toJSON BatchParametersProperty {Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: BatchParametersProperty -> ()
arrayProperties :: BatchParametersProperty -> Maybe BatchArrayPropertiesProperty
jobDefinition :: BatchParametersProperty -> Value Text
jobName :: BatchParametersProperty -> Value Text
retryStrategy :: BatchParametersProperty -> Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"JobDefinition" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
jobDefinition, Key
"JobName" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
jobName]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> BatchArrayPropertiesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ArrayProperties" (BatchArrayPropertiesProperty -> (Key, Value))
-> Maybe BatchArrayPropertiesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BatchArrayPropertiesProperty
arrayProperties,
                  Key -> BatchRetryStrategyProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RetryStrategy" (BatchRetryStrategyProperty -> (Key, Value))
-> Maybe BatchRetryStrategyProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BatchRetryStrategyProperty
retryStrategy])))
instance Property "ArrayProperties" BatchParametersProperty where
  type PropertyType "ArrayProperties" BatchParametersProperty = BatchArrayPropertiesProperty
  set :: PropertyType "ArrayProperties" BatchParametersProperty
-> BatchParametersProperty -> BatchParametersProperty
set PropertyType "ArrayProperties" BatchParametersProperty
newValue BatchParametersProperty {Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: BatchParametersProperty -> ()
arrayProperties :: BatchParametersProperty -> Maybe BatchArrayPropertiesProperty
jobDefinition :: BatchParametersProperty -> Value Text
jobName :: BatchParametersProperty -> Value Text
retryStrategy :: BatchParametersProperty -> Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
    = BatchParametersProperty
        {arrayProperties :: Maybe BatchArrayPropertiesProperty
arrayProperties = BatchArrayPropertiesProperty -> Maybe BatchArrayPropertiesProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ArrayProperties" BatchParametersProperty
BatchArrayPropertiesProperty
newValue, Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: ()
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
instance Property "JobDefinition" BatchParametersProperty where
  type PropertyType "JobDefinition" BatchParametersProperty = Value Prelude.Text
  set :: PropertyType "JobDefinition" BatchParametersProperty
-> BatchParametersProperty -> BatchParametersProperty
set PropertyType "JobDefinition" BatchParametersProperty
newValue BatchParametersProperty {Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: BatchParametersProperty -> ()
arrayProperties :: BatchParametersProperty -> Maybe BatchArrayPropertiesProperty
jobDefinition :: BatchParametersProperty -> Value Text
jobName :: BatchParametersProperty -> Value Text
retryStrategy :: BatchParametersProperty -> Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
    = BatchParametersProperty {jobDefinition :: Value Text
jobDefinition = PropertyType "JobDefinition" BatchParametersProperty
Value Text
newValue, Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
instance Property "JobName" BatchParametersProperty where
  type PropertyType "JobName" BatchParametersProperty = Value Prelude.Text
  set :: PropertyType "JobName" BatchParametersProperty
-> BatchParametersProperty -> BatchParametersProperty
set PropertyType "JobName" BatchParametersProperty
newValue BatchParametersProperty {Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: BatchParametersProperty -> ()
arrayProperties :: BatchParametersProperty -> Maybe BatchArrayPropertiesProperty
jobDefinition :: BatchParametersProperty -> Value Text
jobName :: BatchParametersProperty -> Value Text
retryStrategy :: BatchParametersProperty -> Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
    = BatchParametersProperty {jobName :: Value Text
jobName = PropertyType "JobName" BatchParametersProperty
Value Text
newValue, Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
instance Property "RetryStrategy" BatchParametersProperty where
  type PropertyType "RetryStrategy" BatchParametersProperty = BatchRetryStrategyProperty
  set :: PropertyType "RetryStrategy" BatchParametersProperty
-> BatchParametersProperty -> BatchParametersProperty
set PropertyType "RetryStrategy" BatchParametersProperty
newValue BatchParametersProperty {Maybe BatchArrayPropertiesProperty
Maybe BatchRetryStrategyProperty
()
Value Text
haddock_workaround_ :: BatchParametersProperty -> ()
arrayProperties :: BatchParametersProperty -> Maybe BatchArrayPropertiesProperty
jobDefinition :: BatchParametersProperty -> Value Text
jobName :: BatchParametersProperty -> Value Text
retryStrategy :: BatchParametersProperty -> Maybe BatchRetryStrategyProperty
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
retryStrategy :: Maybe BatchRetryStrategyProperty
..}
    = BatchParametersProperty
        {retryStrategy :: Maybe BatchRetryStrategyProperty
retryStrategy = BatchRetryStrategyProperty -> Maybe BatchRetryStrategyProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RetryStrategy" BatchParametersProperty
BatchRetryStrategyProperty
newValue, Maybe BatchArrayPropertiesProperty
()
Value Text
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
haddock_workaround_ :: ()
arrayProperties :: Maybe BatchArrayPropertiesProperty
jobDefinition :: Value Text
jobName :: Value Text
..}