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