module Stratosphere.DynamoDB.Table.AttributeDefinitionProperty (
        AttributeDefinitionProperty(..), mkAttributeDefinitionProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AttributeDefinitionProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-dynamodb-table-attributedefinition.html>
    AttributeDefinitionProperty {AttributeDefinitionProperty -> ()
haddock_workaround_ :: (),
                                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-dynamodb-table-attributedefinition.html#cfn-dynamodb-table-attributedefinition-attributename>
                                 AttributeDefinitionProperty -> Value Text
attributeName :: (Value Prelude.Text),
                                 -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-dynamodb-table-attributedefinition.html#cfn-dynamodb-table-attributedefinition-attributetype>
                                 AttributeDefinitionProperty -> Value Text
attributeType :: (Value Prelude.Text)}
  deriving stock (AttributeDefinitionProperty -> AttributeDefinitionProperty -> Bool
(AttributeDefinitionProperty
 -> AttributeDefinitionProperty -> Bool)
-> (AttributeDefinitionProperty
    -> AttributeDefinitionProperty -> Bool)
-> Eq AttributeDefinitionProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeDefinitionProperty -> AttributeDefinitionProperty -> Bool
== :: AttributeDefinitionProperty -> AttributeDefinitionProperty -> Bool
$c/= :: AttributeDefinitionProperty -> AttributeDefinitionProperty -> Bool
/= :: AttributeDefinitionProperty -> AttributeDefinitionProperty -> Bool
Prelude.Eq, Int -> AttributeDefinitionProperty -> ShowS
[AttributeDefinitionProperty] -> ShowS
AttributeDefinitionProperty -> String
(Int -> AttributeDefinitionProperty -> ShowS)
-> (AttributeDefinitionProperty -> String)
-> ([AttributeDefinitionProperty] -> ShowS)
-> Show AttributeDefinitionProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeDefinitionProperty -> ShowS
showsPrec :: Int -> AttributeDefinitionProperty -> ShowS
$cshow :: AttributeDefinitionProperty -> String
show :: AttributeDefinitionProperty -> String
$cshowList :: [AttributeDefinitionProperty] -> ShowS
showList :: [AttributeDefinitionProperty] -> ShowS
Prelude.Show)
mkAttributeDefinitionProperty ::
  Value Prelude.Text
  -> Value Prelude.Text -> AttributeDefinitionProperty
mkAttributeDefinitionProperty :: Value Text -> Value Text -> AttributeDefinitionProperty
mkAttributeDefinitionProperty Value Text
attributeName Value Text
attributeType
  = AttributeDefinitionProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), attributeName :: Value Text
attributeName = Value Text
attributeName,
       attributeType :: Value Text
attributeType = Value Text
attributeType}
instance ToResourceProperties AttributeDefinitionProperty where
  toResourceProperties :: AttributeDefinitionProperty -> ResourceProperties
toResourceProperties AttributeDefinitionProperty {()
Value Text
haddock_workaround_ :: AttributeDefinitionProperty -> ()
attributeName :: AttributeDefinitionProperty -> Value Text
attributeType :: AttributeDefinitionProperty -> Value Text
haddock_workaround_ :: ()
attributeName :: Value Text
attributeType :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::DynamoDB::Table.AttributeDefinition",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"AttributeName" 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..= Value Text
attributeName,
                       Key
"AttributeType" 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..= Value Text
attributeType]}
instance JSON.ToJSON AttributeDefinitionProperty where
  toJSON :: AttributeDefinitionProperty -> Value
toJSON AttributeDefinitionProperty {()
Value Text
haddock_workaround_ :: AttributeDefinitionProperty -> ()
attributeName :: AttributeDefinitionProperty -> Value Text
attributeType :: AttributeDefinitionProperty -> Value Text
haddock_workaround_ :: ()
attributeName :: Value Text
attributeType :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"AttributeName" 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..= Value Text
attributeName,
         Key
"AttributeType" 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..= Value Text
attributeType]
instance Property "AttributeName" AttributeDefinitionProperty where
  type PropertyType "AttributeName" AttributeDefinitionProperty = Value Prelude.Text
  set :: PropertyType "AttributeName" AttributeDefinitionProperty
-> AttributeDefinitionProperty -> AttributeDefinitionProperty
set PropertyType "AttributeName" AttributeDefinitionProperty
newValue AttributeDefinitionProperty {()
Value Text
haddock_workaround_ :: AttributeDefinitionProperty -> ()
attributeName :: AttributeDefinitionProperty -> Value Text
attributeType :: AttributeDefinitionProperty -> Value Text
haddock_workaround_ :: ()
attributeName :: Value Text
attributeType :: Value Text
..}
    = AttributeDefinitionProperty {attributeName :: Value Text
attributeName = PropertyType "AttributeName" AttributeDefinitionProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
attributeType :: Value Text
haddock_workaround_ :: ()
attributeType :: Value Text
..}
instance Property "AttributeType" AttributeDefinitionProperty where
  type PropertyType "AttributeType" AttributeDefinitionProperty = Value Prelude.Text
  set :: PropertyType "AttributeType" AttributeDefinitionProperty
-> AttributeDefinitionProperty -> AttributeDefinitionProperty
set PropertyType "AttributeType" AttributeDefinitionProperty
newValue AttributeDefinitionProperty {()
Value Text
haddock_workaround_ :: AttributeDefinitionProperty -> ()
attributeName :: AttributeDefinitionProperty -> Value Text
attributeType :: AttributeDefinitionProperty -> Value Text
haddock_workaround_ :: ()
attributeName :: Value Text
attributeType :: Value Text
..}
    = AttributeDefinitionProperty {attributeType :: Value Text
attributeType = PropertyType "AttributeType" AttributeDefinitionProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
attributeName :: Value Text
haddock_workaround_ :: ()
attributeName :: Value Text
..}