module Stratosphere.ElasticBeanstalk.Application.ApplicationVersionLifecycleConfigProperty (
        module Exports, ApplicationVersionLifecycleConfigProperty(..),
        mkApplicationVersionLifecycleConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.ElasticBeanstalk.Application.MaxAgeRuleProperty as Exports
import {-# SOURCE #-} Stratosphere.ElasticBeanstalk.Application.MaxCountRuleProperty as Exports
import Stratosphere.ResourceProperties
data ApplicationVersionLifecycleConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticbeanstalk-application-applicationversionlifecycleconfig.html>
    ApplicationVersionLifecycleConfigProperty {ApplicationVersionLifecycleConfigProperty -> ()
haddock_workaround_ :: (),
                                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticbeanstalk-application-applicationversionlifecycleconfig.html#cfn-elasticbeanstalk-application-applicationversionlifecycleconfig-maxagerule>
                                               ApplicationVersionLifecycleConfigProperty
-> Maybe MaxAgeRuleProperty
maxAgeRule :: (Prelude.Maybe MaxAgeRuleProperty),
                                               -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-elasticbeanstalk-application-applicationversionlifecycleconfig.html#cfn-elasticbeanstalk-application-applicationversionlifecycleconfig-maxcountrule>
                                               ApplicationVersionLifecycleConfigProperty
-> Maybe MaxCountRuleProperty
maxCountRule :: (Prelude.Maybe MaxCountRuleProperty)}
  deriving stock (ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty -> Bool
(ApplicationVersionLifecycleConfigProperty
 -> ApplicationVersionLifecycleConfigProperty -> Bool)
-> (ApplicationVersionLifecycleConfigProperty
    -> ApplicationVersionLifecycleConfigProperty -> Bool)
-> Eq ApplicationVersionLifecycleConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty -> Bool
== :: ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty -> Bool
$c/= :: ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty -> Bool
/= :: ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty -> Bool
Prelude.Eq, Int -> ApplicationVersionLifecycleConfigProperty -> ShowS
[ApplicationVersionLifecycleConfigProperty] -> ShowS
ApplicationVersionLifecycleConfigProperty -> String
(Int -> ApplicationVersionLifecycleConfigProperty -> ShowS)
-> (ApplicationVersionLifecycleConfigProperty -> String)
-> ([ApplicationVersionLifecycleConfigProperty] -> ShowS)
-> Show ApplicationVersionLifecycleConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplicationVersionLifecycleConfigProperty -> ShowS
showsPrec :: Int -> ApplicationVersionLifecycleConfigProperty -> ShowS
$cshow :: ApplicationVersionLifecycleConfigProperty -> String
show :: ApplicationVersionLifecycleConfigProperty -> String
$cshowList :: [ApplicationVersionLifecycleConfigProperty] -> ShowS
showList :: [ApplicationVersionLifecycleConfigProperty] -> ShowS
Prelude.Show)
mkApplicationVersionLifecycleConfigProperty ::
  ApplicationVersionLifecycleConfigProperty
mkApplicationVersionLifecycleConfigProperty :: ApplicationVersionLifecycleConfigProperty
mkApplicationVersionLifecycleConfigProperty
  = ApplicationVersionLifecycleConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), maxAgeRule :: Maybe MaxAgeRuleProperty
maxAgeRule = Maybe MaxAgeRuleProperty
forall a. Maybe a
Prelude.Nothing,
       maxCountRule :: Maybe MaxCountRuleProperty
maxCountRule = Maybe MaxCountRuleProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ApplicationVersionLifecycleConfigProperty where
  toResourceProperties :: ApplicationVersionLifecycleConfigProperty -> ResourceProperties
toResourceProperties ApplicationVersionLifecycleConfigProperty {Maybe MaxAgeRuleProperty
Maybe MaxCountRuleProperty
()
haddock_workaround_ :: ApplicationVersionLifecycleConfigProperty -> ()
maxAgeRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxAgeRuleProperty
maxCountRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxCountRuleProperty
haddock_workaround_ :: ()
maxAgeRule :: Maybe MaxAgeRuleProperty
maxCountRule :: Maybe MaxCountRuleProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ElasticBeanstalk::Application.ApplicationVersionLifecycleConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> MaxAgeRuleProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MaxAgeRule" (MaxAgeRuleProperty -> (Key, Value))
-> Maybe MaxAgeRuleProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MaxAgeRuleProperty
maxAgeRule,
                            Key -> MaxCountRuleProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MaxCountRule" (MaxCountRuleProperty -> (Key, Value))
-> Maybe MaxCountRuleProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MaxCountRuleProperty
maxCountRule])}
instance JSON.ToJSON ApplicationVersionLifecycleConfigProperty where
  toJSON :: ApplicationVersionLifecycleConfigProperty -> Value
toJSON ApplicationVersionLifecycleConfigProperty {Maybe MaxAgeRuleProperty
Maybe MaxCountRuleProperty
()
haddock_workaround_ :: ApplicationVersionLifecycleConfigProperty -> ()
maxAgeRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxAgeRuleProperty
maxCountRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxCountRuleProperty
haddock_workaround_ :: ()
maxAgeRule :: Maybe MaxAgeRuleProperty
maxCountRule :: Maybe MaxCountRuleProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> MaxAgeRuleProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MaxAgeRule" (MaxAgeRuleProperty -> (Key, Value))
-> Maybe MaxAgeRuleProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MaxAgeRuleProperty
maxAgeRule,
               Key -> MaxCountRuleProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"MaxCountRule" (MaxCountRuleProperty -> (Key, Value))
-> Maybe MaxCountRuleProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MaxCountRuleProperty
maxCountRule]))
instance Property "MaxAgeRule" ApplicationVersionLifecycleConfigProperty where
  type PropertyType "MaxAgeRule" ApplicationVersionLifecycleConfigProperty = MaxAgeRuleProperty
  set :: PropertyType "MaxAgeRule" ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty
set PropertyType "MaxAgeRule" ApplicationVersionLifecycleConfigProperty
newValue ApplicationVersionLifecycleConfigProperty {Maybe MaxAgeRuleProperty
Maybe MaxCountRuleProperty
()
haddock_workaround_ :: ApplicationVersionLifecycleConfigProperty -> ()
maxAgeRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxAgeRuleProperty
maxCountRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxCountRuleProperty
haddock_workaround_ :: ()
maxAgeRule :: Maybe MaxAgeRuleProperty
maxCountRule :: Maybe MaxCountRuleProperty
..}
    = ApplicationVersionLifecycleConfigProperty
        {maxAgeRule :: Maybe MaxAgeRuleProperty
maxAgeRule = MaxAgeRuleProperty -> Maybe MaxAgeRuleProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "MaxAgeRule" ApplicationVersionLifecycleConfigProperty
MaxAgeRuleProperty
newValue, Maybe MaxCountRuleProperty
()
haddock_workaround_ :: ()
maxCountRule :: Maybe MaxCountRuleProperty
haddock_workaround_ :: ()
maxCountRule :: Maybe MaxCountRuleProperty
..}
instance Property "MaxCountRule" ApplicationVersionLifecycleConfigProperty where
  type PropertyType "MaxCountRule" ApplicationVersionLifecycleConfigProperty = MaxCountRuleProperty
  set :: PropertyType
  "MaxCountRule" ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty
-> ApplicationVersionLifecycleConfigProperty
set PropertyType
  "MaxCountRule" ApplicationVersionLifecycleConfigProperty
newValue ApplicationVersionLifecycleConfigProperty {Maybe MaxAgeRuleProperty
Maybe MaxCountRuleProperty
()
haddock_workaround_ :: ApplicationVersionLifecycleConfigProperty -> ()
maxAgeRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxAgeRuleProperty
maxCountRule :: ApplicationVersionLifecycleConfigProperty
-> Maybe MaxCountRuleProperty
haddock_workaround_ :: ()
maxAgeRule :: Maybe MaxAgeRuleProperty
maxCountRule :: Maybe MaxCountRuleProperty
..}
    = ApplicationVersionLifecycleConfigProperty
        {maxCountRule :: Maybe MaxCountRuleProperty
maxCountRule = MaxCountRuleProperty -> Maybe MaxCountRuleProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "MaxCountRule" ApplicationVersionLifecycleConfigProperty
MaxCountRuleProperty
newValue, Maybe MaxAgeRuleProperty
()
haddock_workaround_ :: ()
maxAgeRule :: Maybe MaxAgeRuleProperty
haddock_workaround_ :: ()
maxAgeRule :: Maybe MaxAgeRuleProperty
..}