module Stratosphere.IoTEvents.Input.InputDefinitionProperty (
        module Exports, InputDefinitionProperty(..),
        mkInputDefinitionProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.IoTEvents.Input.AttributeProperty as Exports
import Stratosphere.ResourceProperties
data InputDefinitionProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotevents-input-inputdefinition.html>
    InputDefinitionProperty {InputDefinitionProperty -> ()
haddock_workaround_ :: (),
                             -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotevents-input-inputdefinition.html#cfn-iotevents-input-inputdefinition-attributes>
                             InputDefinitionProperty -> [AttributeProperty]
attributes :: [AttributeProperty]}
  deriving stock (InputDefinitionProperty -> InputDefinitionProperty -> Bool
(InputDefinitionProperty -> InputDefinitionProperty -> Bool)
-> (InputDefinitionProperty -> InputDefinitionProperty -> Bool)
-> Eq InputDefinitionProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputDefinitionProperty -> InputDefinitionProperty -> Bool
== :: InputDefinitionProperty -> InputDefinitionProperty -> Bool
$c/= :: InputDefinitionProperty -> InputDefinitionProperty -> Bool
/= :: InputDefinitionProperty -> InputDefinitionProperty -> Bool
Prelude.Eq, Int -> InputDefinitionProperty -> ShowS
[InputDefinitionProperty] -> ShowS
InputDefinitionProperty -> String
(Int -> InputDefinitionProperty -> ShowS)
-> (InputDefinitionProperty -> String)
-> ([InputDefinitionProperty] -> ShowS)
-> Show InputDefinitionProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputDefinitionProperty -> ShowS
showsPrec :: Int -> InputDefinitionProperty -> ShowS
$cshow :: InputDefinitionProperty -> String
show :: InputDefinitionProperty -> String
$cshowList :: [InputDefinitionProperty] -> ShowS
showList :: [InputDefinitionProperty] -> ShowS
Prelude.Show)
mkInputDefinitionProperty ::
  [AttributeProperty] -> InputDefinitionProperty
mkInputDefinitionProperty :: [AttributeProperty] -> InputDefinitionProperty
mkInputDefinitionProperty [AttributeProperty]
attributes
  = InputDefinitionProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), attributes :: [AttributeProperty]
attributes = [AttributeProperty]
attributes}
instance ToResourceProperties InputDefinitionProperty where
  toResourceProperties :: InputDefinitionProperty -> ResourceProperties
toResourceProperties InputDefinitionProperty {[AttributeProperty]
()
haddock_workaround_ :: InputDefinitionProperty -> ()
attributes :: InputDefinitionProperty -> [AttributeProperty]
haddock_workaround_ :: ()
attributes :: [AttributeProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::IoTEvents::Input.InputDefinition",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Attributes" Key -> [AttributeProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [AttributeProperty]
attributes]}
instance JSON.ToJSON InputDefinitionProperty where
  toJSON :: InputDefinitionProperty -> Value
toJSON InputDefinitionProperty {[AttributeProperty]
()
haddock_workaround_ :: InputDefinitionProperty -> ()
attributes :: InputDefinitionProperty -> [AttributeProperty]
haddock_workaround_ :: ()
attributes :: [AttributeProperty]
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Attributes" Key -> [AttributeProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [AttributeProperty]
attributes]
instance Property "Attributes" InputDefinitionProperty where
  type PropertyType "Attributes" InputDefinitionProperty = [AttributeProperty]
  set :: PropertyType "Attributes" InputDefinitionProperty
-> InputDefinitionProperty -> InputDefinitionProperty
set PropertyType "Attributes" InputDefinitionProperty
newValue InputDefinitionProperty {[AttributeProperty]
()
haddock_workaround_ :: InputDefinitionProperty -> ()
attributes :: InputDefinitionProperty -> [AttributeProperty]
haddock_workaround_ :: ()
attributes :: [AttributeProperty]
..}
    = InputDefinitionProperty {attributes :: [AttributeProperty]
attributes = [AttributeProperty]
PropertyType "Attributes" InputDefinitionProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}