module Stratosphere.GameLift.Fleet.AnywhereConfigurationProperty (
        AnywhereConfigurationProperty(..), mkAnywhereConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AnywhereConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-gamelift-fleet-anywhereconfiguration.html>
    AnywhereConfigurationProperty {AnywhereConfigurationProperty -> ()
haddock_workaround_ :: (),
                                   -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-gamelift-fleet-anywhereconfiguration.html#cfn-gamelift-fleet-anywhereconfiguration-cost>
                                   AnywhereConfigurationProperty -> Value Text
cost :: (Value Prelude.Text)}
  deriving stock (AnywhereConfigurationProperty
-> AnywhereConfigurationProperty -> Bool
(AnywhereConfigurationProperty
 -> AnywhereConfigurationProperty -> Bool)
-> (AnywhereConfigurationProperty
    -> AnywhereConfigurationProperty -> Bool)
-> Eq AnywhereConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnywhereConfigurationProperty
-> AnywhereConfigurationProperty -> Bool
== :: AnywhereConfigurationProperty
-> AnywhereConfigurationProperty -> Bool
$c/= :: AnywhereConfigurationProperty
-> AnywhereConfigurationProperty -> Bool
/= :: AnywhereConfigurationProperty
-> AnywhereConfigurationProperty -> Bool
Prelude.Eq, Int -> AnywhereConfigurationProperty -> ShowS
[AnywhereConfigurationProperty] -> ShowS
AnywhereConfigurationProperty -> String
(Int -> AnywhereConfigurationProperty -> ShowS)
-> (AnywhereConfigurationProperty -> String)
-> ([AnywhereConfigurationProperty] -> ShowS)
-> Show AnywhereConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnywhereConfigurationProperty -> ShowS
showsPrec :: Int -> AnywhereConfigurationProperty -> ShowS
$cshow :: AnywhereConfigurationProperty -> String
show :: AnywhereConfigurationProperty -> String
$cshowList :: [AnywhereConfigurationProperty] -> ShowS
showList :: [AnywhereConfigurationProperty] -> ShowS
Prelude.Show)
mkAnywhereConfigurationProperty ::
  Value Prelude.Text -> AnywhereConfigurationProperty
mkAnywhereConfigurationProperty :: Value Text -> AnywhereConfigurationProperty
mkAnywhereConfigurationProperty Value Text
cost
  = AnywhereConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), cost :: Value Text
cost = Value Text
cost}
instance ToResourceProperties AnywhereConfigurationProperty where
  toResourceProperties :: AnywhereConfigurationProperty -> ResourceProperties
toResourceProperties AnywhereConfigurationProperty {()
Value Text
haddock_workaround_ :: AnywhereConfigurationProperty -> ()
cost :: AnywhereConfigurationProperty -> Value Text
haddock_workaround_ :: ()
cost :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::GameLift::Fleet.AnywhereConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False, properties :: Object
properties = [Key
"Cost" 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
cost]}
instance JSON.ToJSON AnywhereConfigurationProperty where
  toJSON :: AnywhereConfigurationProperty -> Value
toJSON AnywhereConfigurationProperty {()
Value Text
haddock_workaround_ :: AnywhereConfigurationProperty -> ()
cost :: AnywhereConfigurationProperty -> Value Text
haddock_workaround_ :: ()
cost :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Cost" 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
cost]
instance Property "Cost" AnywhereConfigurationProperty where
  type PropertyType "Cost" AnywhereConfigurationProperty = Value Prelude.Text
  set :: PropertyType "Cost" AnywhereConfigurationProperty
-> AnywhereConfigurationProperty -> AnywhereConfigurationProperty
set PropertyType "Cost" AnywhereConfigurationProperty
newValue AnywhereConfigurationProperty {()
Value Text
haddock_workaround_ :: AnywhereConfigurationProperty -> ()
cost :: AnywhereConfigurationProperty -> Value Text
haddock_workaround_ :: ()
cost :: Value Text
..}
    = AnywhereConfigurationProperty {cost :: Value Text
cost = PropertyType "Cost" AnywhereConfigurationProperty
Value Text
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}