module Stratosphere.Greengrass.FunctionDefinitionVersion.DefaultConfigProperty (
module Exports, DefaultConfigProperty(..), mkDefaultConfigProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Greengrass.FunctionDefinitionVersion.ExecutionProperty as Exports
import Stratosphere.ResourceProperties
data DefaultConfigProperty
=
DefaultConfigProperty {DefaultConfigProperty -> ()
haddock_workaround_ :: (),
DefaultConfigProperty -> ExecutionProperty
execution :: ExecutionProperty}
deriving stock (DefaultConfigProperty -> DefaultConfigProperty -> Bool
(DefaultConfigProperty -> DefaultConfigProperty -> Bool)
-> (DefaultConfigProperty -> DefaultConfigProperty -> Bool)
-> Eq DefaultConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultConfigProperty -> DefaultConfigProperty -> Bool
== :: DefaultConfigProperty -> DefaultConfigProperty -> Bool
$c/= :: DefaultConfigProperty -> DefaultConfigProperty -> Bool
/= :: DefaultConfigProperty -> DefaultConfigProperty -> Bool
Prelude.Eq, Int -> DefaultConfigProperty -> ShowS
[DefaultConfigProperty] -> ShowS
DefaultConfigProperty -> String
(Int -> DefaultConfigProperty -> ShowS)
-> (DefaultConfigProperty -> String)
-> ([DefaultConfigProperty] -> ShowS)
-> Show DefaultConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultConfigProperty -> ShowS
showsPrec :: Int -> DefaultConfigProperty -> ShowS
$cshow :: DefaultConfigProperty -> String
show :: DefaultConfigProperty -> String
$cshowList :: [DefaultConfigProperty] -> ShowS
showList :: [DefaultConfigProperty] -> ShowS
Prelude.Show)
mkDefaultConfigProperty ::
ExecutionProperty -> DefaultConfigProperty
mkDefaultConfigProperty :: ExecutionProperty -> DefaultConfigProperty
mkDefaultConfigProperty ExecutionProperty
execution
= DefaultConfigProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), execution :: ExecutionProperty
execution = ExecutionProperty
execution}
instance ToResourceProperties DefaultConfigProperty where
toResourceProperties :: DefaultConfigProperty -> ResourceProperties
toResourceProperties DefaultConfigProperty {()
ExecutionProperty
haddock_workaround_ :: DefaultConfigProperty -> ()
execution :: DefaultConfigProperty -> ExecutionProperty
haddock_workaround_ :: ()
execution :: ExecutionProperty
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::Greengrass::FunctionDefinitionVersion.DefaultConfig",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Key
"Execution" Key -> ExecutionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ExecutionProperty
execution]}
instance JSON.ToJSON DefaultConfigProperty where
toJSON :: DefaultConfigProperty -> Value
toJSON DefaultConfigProperty {()
ExecutionProperty
haddock_workaround_ :: DefaultConfigProperty -> ()
execution :: DefaultConfigProperty -> ExecutionProperty
haddock_workaround_ :: ()
execution :: ExecutionProperty
..}
= [(Key, Value)] -> Value
JSON.object [Key
"Execution" Key -> ExecutionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ExecutionProperty
execution]
instance Property "Execution" DefaultConfigProperty where
type PropertyType "Execution" DefaultConfigProperty = ExecutionProperty
set :: PropertyType "Execution" DefaultConfigProperty
-> DefaultConfigProperty -> DefaultConfigProperty
set PropertyType "Execution" DefaultConfigProperty
newValue DefaultConfigProperty {()
ExecutionProperty
haddock_workaround_ :: DefaultConfigProperty -> ()
execution :: DefaultConfigProperty -> ExecutionProperty
haddock_workaround_ :: ()
execution :: ExecutionProperty
..}
= DefaultConfigProperty {execution :: ExecutionProperty
execution = PropertyType "Execution" DefaultConfigProperty
ExecutionProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}