module Stratosphere.ECS.Cluster.ClusterConfigurationProperty (
        module Exports, ClusterConfigurationProperty(..),
        mkClusterConfigurationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.ECS.Cluster.ExecuteCommandConfigurationProperty as Exports
import {-# SOURCE #-} Stratosphere.ECS.Cluster.ManagedStorageConfigurationProperty as Exports
import Stratosphere.ResourceProperties
data ClusterConfigurationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-ecs-cluster-clusterconfiguration.html>
    ClusterConfigurationProperty {ClusterConfigurationProperty -> ()
haddock_workaround_ :: (),
                                  -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-ecs-cluster-clusterconfiguration.html#cfn-ecs-cluster-clusterconfiguration-executecommandconfiguration>
                                  ClusterConfigurationProperty
-> Maybe ExecuteCommandConfigurationProperty
executeCommandConfiguration :: (Prelude.Maybe ExecuteCommandConfigurationProperty),
                                  -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-ecs-cluster-clusterconfiguration.html#cfn-ecs-cluster-clusterconfiguration-managedstorageconfiguration>
                                  ClusterConfigurationProperty
-> Maybe ManagedStorageConfigurationProperty
managedStorageConfiguration :: (Prelude.Maybe ManagedStorageConfigurationProperty)}
  deriving stock (ClusterConfigurationProperty
-> ClusterConfigurationProperty -> Bool
(ClusterConfigurationProperty
 -> ClusterConfigurationProperty -> Bool)
-> (ClusterConfigurationProperty
    -> ClusterConfigurationProperty -> Bool)
-> Eq ClusterConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClusterConfigurationProperty
-> ClusterConfigurationProperty -> Bool
== :: ClusterConfigurationProperty
-> ClusterConfigurationProperty -> Bool
$c/= :: ClusterConfigurationProperty
-> ClusterConfigurationProperty -> Bool
/= :: ClusterConfigurationProperty
-> ClusterConfigurationProperty -> Bool
Prelude.Eq, Int -> ClusterConfigurationProperty -> ShowS
[ClusterConfigurationProperty] -> ShowS
ClusterConfigurationProperty -> String
(Int -> ClusterConfigurationProperty -> ShowS)
-> (ClusterConfigurationProperty -> String)
-> ([ClusterConfigurationProperty] -> ShowS)
-> Show ClusterConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClusterConfigurationProperty -> ShowS
showsPrec :: Int -> ClusterConfigurationProperty -> ShowS
$cshow :: ClusterConfigurationProperty -> String
show :: ClusterConfigurationProperty -> String
$cshowList :: [ClusterConfigurationProperty] -> ShowS
showList :: [ClusterConfigurationProperty] -> ShowS
Prelude.Show)
mkClusterConfigurationProperty :: ClusterConfigurationProperty
mkClusterConfigurationProperty :: ClusterConfigurationProperty
mkClusterConfigurationProperty
  = ClusterConfigurationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
executeCommandConfiguration = Maybe ExecuteCommandConfigurationProperty
forall a. Maybe a
Prelude.Nothing,
       managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
managedStorageConfiguration = Maybe ManagedStorageConfigurationProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ClusterConfigurationProperty where
  toResourceProperties :: ClusterConfigurationProperty -> ResourceProperties
toResourceProperties ClusterConfigurationProperty {Maybe ExecuteCommandConfigurationProperty
Maybe ManagedStorageConfigurationProperty
()
haddock_workaround_ :: ClusterConfigurationProperty -> ()
executeCommandConfiguration :: ClusterConfigurationProperty
-> Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: ClusterConfigurationProperty
-> Maybe ManagedStorageConfigurationProperty
haddock_workaround_ :: ()
executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ECS::Cluster.ClusterConfiguration",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> ExecuteCommandConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ExecuteCommandConfiguration"
                              (ExecuteCommandConfigurationProperty -> (Key, Value))
-> Maybe ExecuteCommandConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ExecuteCommandConfigurationProperty
executeCommandConfiguration,
                            Key -> ManagedStorageConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ManagedStorageConfiguration"
                              (ManagedStorageConfigurationProperty -> (Key, Value))
-> Maybe ManagedStorageConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ManagedStorageConfigurationProperty
managedStorageConfiguration])}
instance JSON.ToJSON ClusterConfigurationProperty where
  toJSON :: ClusterConfigurationProperty -> Value
toJSON ClusterConfigurationProperty {Maybe ExecuteCommandConfigurationProperty
Maybe ManagedStorageConfigurationProperty
()
haddock_workaround_ :: ClusterConfigurationProperty -> ()
executeCommandConfiguration :: ClusterConfigurationProperty
-> Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: ClusterConfigurationProperty
-> Maybe ManagedStorageConfigurationProperty
haddock_workaround_ :: ()
executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> ExecuteCommandConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ExecuteCommandConfiguration"
                 (ExecuteCommandConfigurationProperty -> (Key, Value))
-> Maybe ExecuteCommandConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ExecuteCommandConfigurationProperty
executeCommandConfiguration,
               Key -> ManagedStorageConfigurationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ManagedStorageConfiguration"
                 (ManagedStorageConfigurationProperty -> (Key, Value))
-> Maybe ManagedStorageConfigurationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ManagedStorageConfigurationProperty
managedStorageConfiguration]))
instance Property "ExecuteCommandConfiguration" ClusterConfigurationProperty where
  type PropertyType "ExecuteCommandConfiguration" ClusterConfigurationProperty = ExecuteCommandConfigurationProperty
  set :: PropertyType
  "ExecuteCommandConfiguration" ClusterConfigurationProperty
-> ClusterConfigurationProperty -> ClusterConfigurationProperty
set PropertyType
  "ExecuteCommandConfiguration" ClusterConfigurationProperty
newValue ClusterConfigurationProperty {Maybe ExecuteCommandConfigurationProperty
Maybe ManagedStorageConfigurationProperty
()
haddock_workaround_ :: ClusterConfigurationProperty -> ()
executeCommandConfiguration :: ClusterConfigurationProperty
-> Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: ClusterConfigurationProperty
-> Maybe ManagedStorageConfigurationProperty
haddock_workaround_ :: ()
executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
..}
    = ClusterConfigurationProperty
        {executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
executeCommandConfiguration = ExecuteCommandConfigurationProperty
-> Maybe ExecuteCommandConfigurationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "ExecuteCommandConfiguration" ClusterConfigurationProperty
ExecuteCommandConfigurationProperty
newValue, Maybe ManagedStorageConfigurationProperty
()
haddock_workaround_ :: ()
managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
haddock_workaround_ :: ()
managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
..}
instance Property "ManagedStorageConfiguration" ClusterConfigurationProperty where
  type PropertyType "ManagedStorageConfiguration" ClusterConfigurationProperty = ManagedStorageConfigurationProperty
  set :: PropertyType
  "ManagedStorageConfiguration" ClusterConfigurationProperty
-> ClusterConfigurationProperty -> ClusterConfigurationProperty
set PropertyType
  "ManagedStorageConfiguration" ClusterConfigurationProperty
newValue ClusterConfigurationProperty {Maybe ExecuteCommandConfigurationProperty
Maybe ManagedStorageConfigurationProperty
()
haddock_workaround_ :: ClusterConfigurationProperty -> ()
executeCommandConfiguration :: ClusterConfigurationProperty
-> Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: ClusterConfigurationProperty
-> Maybe ManagedStorageConfigurationProperty
haddock_workaround_ :: ()
executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
..}
    = ClusterConfigurationProperty
        {managedStorageConfiguration :: Maybe ManagedStorageConfigurationProperty
managedStorageConfiguration = ManagedStorageConfigurationProperty
-> Maybe ManagedStorageConfigurationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "ManagedStorageConfiguration" ClusterConfigurationProperty
ManagedStorageConfigurationProperty
newValue, Maybe ExecuteCommandConfigurationProperty
()
haddock_workaround_ :: ()
executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
haddock_workaround_ :: ()
executeCommandConfiguration :: Maybe ExecuteCommandConfigurationProperty
..}