module Stratosphere.ImageBuilder.LifecyclePolicy.PolicyDetailProperty (
        module Exports, PolicyDetailProperty(..), mkPolicyDetailProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.ImageBuilder.LifecyclePolicy.ActionProperty as Exports
import {-# SOURCE #-} Stratosphere.ImageBuilder.LifecyclePolicy.ExclusionRulesProperty as Exports
import {-# SOURCE #-} Stratosphere.ImageBuilder.LifecyclePolicy.FilterProperty as Exports
import Stratosphere.ResourceProperties
data PolicyDetailProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-imagebuilder-lifecyclepolicy-policydetail.html>
    PolicyDetailProperty {PolicyDetailProperty -> ()
haddock_workaround_ :: (),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-imagebuilder-lifecyclepolicy-policydetail.html#cfn-imagebuilder-lifecyclepolicy-policydetail-action>
                          PolicyDetailProperty -> ActionProperty
action :: ActionProperty,
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-imagebuilder-lifecyclepolicy-policydetail.html#cfn-imagebuilder-lifecyclepolicy-policydetail-exclusionrules>
                          PolicyDetailProperty -> Maybe ExclusionRulesProperty
exclusionRules :: (Prelude.Maybe ExclusionRulesProperty),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-imagebuilder-lifecyclepolicy-policydetail.html#cfn-imagebuilder-lifecyclepolicy-policydetail-filter>
                          PolicyDetailProperty -> FilterProperty
filter :: FilterProperty}
  deriving stock (PolicyDetailProperty -> PolicyDetailProperty -> Bool
(PolicyDetailProperty -> PolicyDetailProperty -> Bool)
-> (PolicyDetailProperty -> PolicyDetailProperty -> Bool)
-> Eq PolicyDetailProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PolicyDetailProperty -> PolicyDetailProperty -> Bool
== :: PolicyDetailProperty -> PolicyDetailProperty -> Bool
$c/= :: PolicyDetailProperty -> PolicyDetailProperty -> Bool
/= :: PolicyDetailProperty -> PolicyDetailProperty -> Bool
Prelude.Eq, Int -> PolicyDetailProperty -> ShowS
[PolicyDetailProperty] -> ShowS
PolicyDetailProperty -> String
(Int -> PolicyDetailProperty -> ShowS)
-> (PolicyDetailProperty -> String)
-> ([PolicyDetailProperty] -> ShowS)
-> Show PolicyDetailProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PolicyDetailProperty -> ShowS
showsPrec :: Int -> PolicyDetailProperty -> ShowS
$cshow :: PolicyDetailProperty -> String
show :: PolicyDetailProperty -> String
$cshowList :: [PolicyDetailProperty] -> ShowS
showList :: [PolicyDetailProperty] -> ShowS
Prelude.Show)
mkPolicyDetailProperty ::
  ActionProperty -> FilterProperty -> PolicyDetailProperty
mkPolicyDetailProperty :: ActionProperty -> FilterProperty -> PolicyDetailProperty
mkPolicyDetailProperty ActionProperty
action FilterProperty
filter
  = PolicyDetailProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), action :: ActionProperty
action = ActionProperty
action, filter :: FilterProperty
filter = FilterProperty
filter,
       exclusionRules :: Maybe ExclusionRulesProperty
exclusionRules = Maybe ExclusionRulesProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties PolicyDetailProperty where
  toResourceProperties :: PolicyDetailProperty -> ResourceProperties
toResourceProperties PolicyDetailProperty {Maybe ExclusionRulesProperty
()
FilterProperty
ActionProperty
haddock_workaround_ :: PolicyDetailProperty -> ()
action :: PolicyDetailProperty -> ActionProperty
exclusionRules :: PolicyDetailProperty -> Maybe ExclusionRulesProperty
filter :: PolicyDetailProperty -> FilterProperty
haddock_workaround_ :: ()
action :: ActionProperty
exclusionRules :: Maybe ExclusionRulesProperty
filter :: FilterProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ImageBuilder::LifecyclePolicy.PolicyDetail",
         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
"Action" Key -> ActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ActionProperty
action, Key
"Filter" Key -> FilterProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= FilterProperty
filter]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> ExclusionRulesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ExclusionRules" (ExclusionRulesProperty -> (Key, Value))
-> Maybe ExclusionRulesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ExclusionRulesProperty
exclusionRules]))}
instance JSON.ToJSON PolicyDetailProperty where
  toJSON :: PolicyDetailProperty -> Value
toJSON PolicyDetailProperty {Maybe ExclusionRulesProperty
()
FilterProperty
ActionProperty
haddock_workaround_ :: PolicyDetailProperty -> ()
action :: PolicyDetailProperty -> ActionProperty
exclusionRules :: PolicyDetailProperty -> Maybe ExclusionRulesProperty
filter :: PolicyDetailProperty -> FilterProperty
haddock_workaround_ :: ()
action :: ActionProperty
exclusionRules :: Maybe ExclusionRulesProperty
filter :: FilterProperty
..}
    = [(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
"Action" Key -> ActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ActionProperty
action, Key
"Filter" Key -> FilterProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= FilterProperty
filter]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> ExclusionRulesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ExclusionRules" (ExclusionRulesProperty -> (Key, Value))
-> Maybe ExclusionRulesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ExclusionRulesProperty
exclusionRules])))
instance Property "Action" PolicyDetailProperty where
  type PropertyType "Action" PolicyDetailProperty = ActionProperty
  set :: PropertyType "Action" PolicyDetailProperty
-> PolicyDetailProperty -> PolicyDetailProperty
set PropertyType "Action" PolicyDetailProperty
newValue PolicyDetailProperty {Maybe ExclusionRulesProperty
()
FilterProperty
ActionProperty
haddock_workaround_ :: PolicyDetailProperty -> ()
action :: PolicyDetailProperty -> ActionProperty
exclusionRules :: PolicyDetailProperty -> Maybe ExclusionRulesProperty
filter :: PolicyDetailProperty -> FilterProperty
haddock_workaround_ :: ()
action :: ActionProperty
exclusionRules :: Maybe ExclusionRulesProperty
filter :: FilterProperty
..}
    = PolicyDetailProperty {action :: ActionProperty
action = PropertyType "Action" PolicyDetailProperty
ActionProperty
newValue, Maybe ExclusionRulesProperty
()
FilterProperty
haddock_workaround_ :: ()
exclusionRules :: Maybe ExclusionRulesProperty
filter :: FilterProperty
haddock_workaround_ :: ()
exclusionRules :: Maybe ExclusionRulesProperty
filter :: FilterProperty
..}
instance Property "ExclusionRules" PolicyDetailProperty where
  type PropertyType "ExclusionRules" PolicyDetailProperty = ExclusionRulesProperty
  set :: PropertyType "ExclusionRules" PolicyDetailProperty
-> PolicyDetailProperty -> PolicyDetailProperty
set PropertyType "ExclusionRules" PolicyDetailProperty
newValue PolicyDetailProperty {Maybe ExclusionRulesProperty
()
FilterProperty
ActionProperty
haddock_workaround_ :: PolicyDetailProperty -> ()
action :: PolicyDetailProperty -> ActionProperty
exclusionRules :: PolicyDetailProperty -> Maybe ExclusionRulesProperty
filter :: PolicyDetailProperty -> FilterProperty
haddock_workaround_ :: ()
action :: ActionProperty
exclusionRules :: Maybe ExclusionRulesProperty
filter :: FilterProperty
..}
    = PolicyDetailProperty {exclusionRules :: Maybe ExclusionRulesProperty
exclusionRules = ExclusionRulesProperty -> Maybe ExclusionRulesProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ExclusionRules" PolicyDetailProperty
ExclusionRulesProperty
newValue, ()
FilterProperty
ActionProperty
haddock_workaround_ :: ()
action :: ActionProperty
filter :: FilterProperty
haddock_workaround_ :: ()
action :: ActionProperty
filter :: FilterProperty
..}
instance Property "Filter" PolicyDetailProperty where
  type PropertyType "Filter" PolicyDetailProperty = FilterProperty
  set :: PropertyType "Filter" PolicyDetailProperty
-> PolicyDetailProperty -> PolicyDetailProperty
set PropertyType "Filter" PolicyDetailProperty
newValue PolicyDetailProperty {Maybe ExclusionRulesProperty
()
FilterProperty
ActionProperty
haddock_workaround_ :: PolicyDetailProperty -> ()
action :: PolicyDetailProperty -> ActionProperty
exclusionRules :: PolicyDetailProperty -> Maybe ExclusionRulesProperty
filter :: PolicyDetailProperty -> FilterProperty
haddock_workaround_ :: ()
action :: ActionProperty
exclusionRules :: Maybe ExclusionRulesProperty
filter :: FilterProperty
..}
    = PolicyDetailProperty {filter :: FilterProperty
filter = PropertyType "Filter" PolicyDetailProperty
FilterProperty
newValue, Maybe ExclusionRulesProperty
()
ActionProperty
haddock_workaround_ :: ()
action :: ActionProperty
exclusionRules :: Maybe ExclusionRulesProperty
haddock_workaround_ :: ()
action :: ActionProperty
exclusionRules :: Maybe ExclusionRulesProperty
..}