module Stratosphere.ApiGateway.UsagePlanKey (
        UsagePlanKey(..), mkUsagePlanKey
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data UsagePlanKey
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-usageplankey.html>
    UsagePlanKey {UsagePlanKey -> ()
haddock_workaround_ :: (),
                  -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-usageplankey.html#cfn-apigateway-usageplankey-keyid>
                  UsagePlanKey -> Value Text
keyId :: (Value Prelude.Text),
                  -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-usageplankey.html#cfn-apigateway-usageplankey-keytype>
                  UsagePlanKey -> Value Text
keyType :: (Value Prelude.Text),
                  -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-apigateway-usageplankey.html#cfn-apigateway-usageplankey-usageplanid>
                  UsagePlanKey -> Value Text
usagePlanId :: (Value Prelude.Text)}
  deriving stock (UsagePlanKey -> UsagePlanKey -> Bool
(UsagePlanKey -> UsagePlanKey -> Bool)
-> (UsagePlanKey -> UsagePlanKey -> Bool) -> Eq UsagePlanKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UsagePlanKey -> UsagePlanKey -> Bool
== :: UsagePlanKey -> UsagePlanKey -> Bool
$c/= :: UsagePlanKey -> UsagePlanKey -> Bool
/= :: UsagePlanKey -> UsagePlanKey -> Bool
Prelude.Eq, Int -> UsagePlanKey -> ShowS
[UsagePlanKey] -> ShowS
UsagePlanKey -> String
(Int -> UsagePlanKey -> ShowS)
-> (UsagePlanKey -> String)
-> ([UsagePlanKey] -> ShowS)
-> Show UsagePlanKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UsagePlanKey -> ShowS
showsPrec :: Int -> UsagePlanKey -> ShowS
$cshow :: UsagePlanKey -> String
show :: UsagePlanKey -> String
$cshowList :: [UsagePlanKey] -> ShowS
showList :: [UsagePlanKey] -> ShowS
Prelude.Show)
mkUsagePlanKey ::
  Value Prelude.Text
  -> Value Prelude.Text -> Value Prelude.Text -> UsagePlanKey
mkUsagePlanKey :: Value Text -> Value Text -> Value Text -> UsagePlanKey
mkUsagePlanKey Value Text
keyId Value Text
keyType Value Text
usagePlanId
  = UsagePlanKey
      {haddock_workaround_ :: ()
haddock_workaround_ = (), keyId :: Value Text
keyId = Value Text
keyId, keyType :: Value Text
keyType = Value Text
keyType,
       usagePlanId :: Value Text
usagePlanId = Value Text
usagePlanId}
instance ToResourceProperties UsagePlanKey where
  toResourceProperties :: UsagePlanKey -> ResourceProperties
toResourceProperties UsagePlanKey {()
Value Text
haddock_workaround_ :: UsagePlanKey -> ()
keyId :: UsagePlanKey -> Value Text
keyType :: UsagePlanKey -> Value Text
usagePlanId :: UsagePlanKey -> Value Text
haddock_workaround_ :: ()
keyId :: Value Text
keyType :: Value Text
usagePlanId :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ApiGateway::UsagePlanKey",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"KeyId" 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
keyId, 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,
                       Key
"UsagePlanId" 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
usagePlanId]}
instance JSON.ToJSON UsagePlanKey where
  toJSON :: UsagePlanKey -> Value
toJSON UsagePlanKey {()
Value Text
haddock_workaround_ :: UsagePlanKey -> ()
keyId :: UsagePlanKey -> Value Text
keyType :: UsagePlanKey -> Value Text
usagePlanId :: UsagePlanKey -> Value Text
haddock_workaround_ :: ()
keyId :: Value Text
keyType :: Value Text
usagePlanId :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"KeyId" 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
keyId, 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,
         Key
"UsagePlanId" 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
usagePlanId]
instance Property "KeyId" UsagePlanKey where
  type PropertyType "KeyId" UsagePlanKey = Value Prelude.Text
  set :: PropertyType "KeyId" UsagePlanKey -> UsagePlanKey -> UsagePlanKey
set PropertyType "KeyId" UsagePlanKey
newValue UsagePlanKey {()
Value Text
haddock_workaround_ :: UsagePlanKey -> ()
keyId :: UsagePlanKey -> Value Text
keyType :: UsagePlanKey -> Value Text
usagePlanId :: UsagePlanKey -> Value Text
haddock_workaround_ :: ()
keyId :: Value Text
keyType :: Value Text
usagePlanId :: Value Text
..}
    = UsagePlanKey {keyId :: Value Text
keyId = PropertyType "KeyId" UsagePlanKey
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
keyType :: Value Text
usagePlanId :: Value Text
haddock_workaround_ :: ()
keyType :: Value Text
usagePlanId :: Value Text
..}
instance Property "KeyType" UsagePlanKey where
  type PropertyType "KeyType" UsagePlanKey = Value Prelude.Text
  set :: PropertyType "KeyType" UsagePlanKey -> UsagePlanKey -> UsagePlanKey
set PropertyType "KeyType" UsagePlanKey
newValue UsagePlanKey {()
Value Text
haddock_workaround_ :: UsagePlanKey -> ()
keyId :: UsagePlanKey -> Value Text
keyType :: UsagePlanKey -> Value Text
usagePlanId :: UsagePlanKey -> Value Text
haddock_workaround_ :: ()
keyId :: Value Text
keyType :: Value Text
usagePlanId :: Value Text
..}
    = UsagePlanKey {keyType :: Value Text
keyType = PropertyType "KeyType" UsagePlanKey
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
keyId :: Value Text
usagePlanId :: Value Text
haddock_workaround_ :: ()
keyId :: Value Text
usagePlanId :: Value Text
..}
instance Property "UsagePlanId" UsagePlanKey where
  type PropertyType "UsagePlanId" UsagePlanKey = Value Prelude.Text
  set :: PropertyType "UsagePlanId" UsagePlanKey
-> UsagePlanKey -> UsagePlanKey
set PropertyType "UsagePlanId" UsagePlanKey
newValue UsagePlanKey {()
Value Text
haddock_workaround_ :: UsagePlanKey -> ()
keyId :: UsagePlanKey -> Value Text
keyType :: UsagePlanKey -> Value Text
usagePlanId :: UsagePlanKey -> Value Text
haddock_workaround_ :: ()
keyId :: Value Text
keyType :: Value Text
usagePlanId :: Value Text
..}
    = UsagePlanKey {usagePlanId :: Value Text
usagePlanId = PropertyType "UsagePlanId" UsagePlanKey
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
keyId :: Value Text
keyType :: Value Text
haddock_workaround_ :: ()
keyId :: Value Text
keyType :: Value Text
..}