module Stratosphere.GreengrassV2.Deployment.ComponentDeploymentSpecificationProperty (
module Exports, ComponentDeploymentSpecificationProperty(..),
mkComponentDeploymentSpecificationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.GreengrassV2.Deployment.ComponentConfigurationUpdateProperty as Exports
import {-# SOURCE #-} Stratosphere.GreengrassV2.Deployment.ComponentRunWithProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ComponentDeploymentSpecificationProperty
=
ComponentDeploymentSpecificationProperty {ComponentDeploymentSpecificationProperty -> ()
haddock_workaround_ :: (),
ComponentDeploymentSpecificationProperty -> Maybe (Value Text)
componentVersion :: (Prelude.Maybe (Value Prelude.Text)),
ComponentDeploymentSpecificationProperty
-> Maybe ComponentConfigurationUpdateProperty
configurationUpdate :: (Prelude.Maybe ComponentConfigurationUpdateProperty),
ComponentDeploymentSpecificationProperty
-> Maybe ComponentRunWithProperty
runWith :: (Prelude.Maybe ComponentRunWithProperty)}
deriving stock (ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty -> Bool
(ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty -> Bool)
-> (ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty -> Bool)
-> Eq ComponentDeploymentSpecificationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty -> Bool
== :: ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty -> Bool
$c/= :: ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty -> Bool
/= :: ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty -> Bool
Prelude.Eq, Int -> ComponentDeploymentSpecificationProperty -> ShowS
[ComponentDeploymentSpecificationProperty] -> ShowS
ComponentDeploymentSpecificationProperty -> String
(Int -> ComponentDeploymentSpecificationProperty -> ShowS)
-> (ComponentDeploymentSpecificationProperty -> String)
-> ([ComponentDeploymentSpecificationProperty] -> ShowS)
-> Show ComponentDeploymentSpecificationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentDeploymentSpecificationProperty -> ShowS
showsPrec :: Int -> ComponentDeploymentSpecificationProperty -> ShowS
$cshow :: ComponentDeploymentSpecificationProperty -> String
show :: ComponentDeploymentSpecificationProperty -> String
$cshowList :: [ComponentDeploymentSpecificationProperty] -> ShowS
showList :: [ComponentDeploymentSpecificationProperty] -> ShowS
Prelude.Show)
mkComponentDeploymentSpecificationProperty ::
ComponentDeploymentSpecificationProperty
mkComponentDeploymentSpecificationProperty :: ComponentDeploymentSpecificationProperty
mkComponentDeploymentSpecificationProperty
= ComponentDeploymentSpecificationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), componentVersion :: Maybe (Value Text)
componentVersion = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing,
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
configurationUpdate = Maybe ComponentConfigurationUpdateProperty
forall a. Maybe a
Prelude.Nothing, runWith :: Maybe ComponentRunWithProperty
runWith = Maybe ComponentRunWithProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ComponentDeploymentSpecificationProperty where
toResourceProperties :: ComponentDeploymentSpecificationProperty -> ResourceProperties
toResourceProperties ComponentDeploymentSpecificationProperty {Maybe (Value Text)
Maybe ComponentConfigurationUpdateProperty
Maybe ComponentRunWithProperty
()
haddock_workaround_ :: ComponentDeploymentSpecificationProperty -> ()
componentVersion :: ComponentDeploymentSpecificationProperty -> Maybe (Value Text)
configurationUpdate :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentConfigurationUpdateProperty
runWith :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentRunWithProperty
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
runWith :: Maybe ComponentRunWithProperty
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::GreengrassV2::Deployment.ComponentDeploymentSpecification",
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 -> 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..=) Key
"ComponentVersion" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
componentVersion,
Key -> ComponentConfigurationUpdateProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ConfigurationUpdate" (ComponentConfigurationUpdateProperty -> (Key, Value))
-> Maybe ComponentConfigurationUpdateProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ComponentConfigurationUpdateProperty
configurationUpdate,
Key -> ComponentRunWithProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RunWith" (ComponentRunWithProperty -> (Key, Value))
-> Maybe ComponentRunWithProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ComponentRunWithProperty
runWith])}
instance JSON.ToJSON ComponentDeploymentSpecificationProperty where
toJSON :: ComponentDeploymentSpecificationProperty -> Value
toJSON ComponentDeploymentSpecificationProperty {Maybe (Value Text)
Maybe ComponentConfigurationUpdateProperty
Maybe ComponentRunWithProperty
()
haddock_workaround_ :: ComponentDeploymentSpecificationProperty -> ()
componentVersion :: ComponentDeploymentSpecificationProperty -> Maybe (Value Text)
configurationUpdate :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentConfigurationUpdateProperty
runWith :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentRunWithProperty
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
runWith :: Maybe ComponentRunWithProperty
..}
= [(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 -> 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..=) Key
"ComponentVersion" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
componentVersion,
Key -> ComponentConfigurationUpdateProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ConfigurationUpdate" (ComponentConfigurationUpdateProperty -> (Key, Value))
-> Maybe ComponentConfigurationUpdateProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ComponentConfigurationUpdateProperty
configurationUpdate,
Key -> ComponentRunWithProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RunWith" (ComponentRunWithProperty -> (Key, Value))
-> Maybe ComponentRunWithProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ComponentRunWithProperty
runWith]))
instance Property "ComponentVersion" ComponentDeploymentSpecificationProperty where
type PropertyType "ComponentVersion" ComponentDeploymentSpecificationProperty = Value Prelude.Text
set :: PropertyType
"ComponentVersion" ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty
set PropertyType
"ComponentVersion" ComponentDeploymentSpecificationProperty
newValue ComponentDeploymentSpecificationProperty {Maybe (Value Text)
Maybe ComponentConfigurationUpdateProperty
Maybe ComponentRunWithProperty
()
haddock_workaround_ :: ComponentDeploymentSpecificationProperty -> ()
componentVersion :: ComponentDeploymentSpecificationProperty -> Maybe (Value Text)
configurationUpdate :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentConfigurationUpdateProperty
runWith :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentRunWithProperty
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
runWith :: Maybe ComponentRunWithProperty
..}
= ComponentDeploymentSpecificationProperty
{componentVersion :: Maybe (Value Text)
componentVersion = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
"ComponentVersion" ComponentDeploymentSpecificationProperty
Value Text
newValue, Maybe ComponentConfigurationUpdateProperty
Maybe ComponentRunWithProperty
()
haddock_workaround_ :: ()
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
runWith :: Maybe ComponentRunWithProperty
haddock_workaround_ :: ()
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
runWith :: Maybe ComponentRunWithProperty
..}
instance Property "ConfigurationUpdate" ComponentDeploymentSpecificationProperty where
type PropertyType "ConfigurationUpdate" ComponentDeploymentSpecificationProperty = ComponentConfigurationUpdateProperty
set :: PropertyType
"ConfigurationUpdate" ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty
set PropertyType
"ConfigurationUpdate" ComponentDeploymentSpecificationProperty
newValue ComponentDeploymentSpecificationProperty {Maybe (Value Text)
Maybe ComponentConfigurationUpdateProperty
Maybe ComponentRunWithProperty
()
haddock_workaround_ :: ComponentDeploymentSpecificationProperty -> ()
componentVersion :: ComponentDeploymentSpecificationProperty -> Maybe (Value Text)
configurationUpdate :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentConfigurationUpdateProperty
runWith :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentRunWithProperty
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
runWith :: Maybe ComponentRunWithProperty
..}
= ComponentDeploymentSpecificationProperty
{configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
configurationUpdate = ComponentConfigurationUpdateProperty
-> Maybe ComponentConfigurationUpdateProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
"ConfigurationUpdate" ComponentDeploymentSpecificationProperty
ComponentConfigurationUpdateProperty
newValue, Maybe (Value Text)
Maybe ComponentRunWithProperty
()
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
runWith :: Maybe ComponentRunWithProperty
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
runWith :: Maybe ComponentRunWithProperty
..}
instance Property "RunWith" ComponentDeploymentSpecificationProperty where
type PropertyType "RunWith" ComponentDeploymentSpecificationProperty = ComponentRunWithProperty
set :: PropertyType "RunWith" ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty
-> ComponentDeploymentSpecificationProperty
set PropertyType "RunWith" ComponentDeploymentSpecificationProperty
newValue ComponentDeploymentSpecificationProperty {Maybe (Value Text)
Maybe ComponentConfigurationUpdateProperty
Maybe ComponentRunWithProperty
()
haddock_workaround_ :: ComponentDeploymentSpecificationProperty -> ()
componentVersion :: ComponentDeploymentSpecificationProperty -> Maybe (Value Text)
configurationUpdate :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentConfigurationUpdateProperty
runWith :: ComponentDeploymentSpecificationProperty
-> Maybe ComponentRunWithProperty
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
runWith :: Maybe ComponentRunWithProperty
..}
= ComponentDeploymentSpecificationProperty
{runWith :: Maybe ComponentRunWithProperty
runWith = ComponentRunWithProperty -> Maybe ComponentRunWithProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RunWith" ComponentDeploymentSpecificationProperty
ComponentRunWithProperty
newValue, Maybe (Value Text)
Maybe ComponentConfigurationUpdateProperty
()
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
haddock_workaround_ :: ()
componentVersion :: Maybe (Value Text)
configurationUpdate :: Maybe ComponentConfigurationUpdateProperty
..}