module Stratosphere.SageMaker.Cluster.OrchestratorProperty (
        module Exports, OrchestratorProperty(..), mkOrchestratorProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.SageMaker.Cluster.ClusterOrchestratorEksConfigProperty as Exports
import Stratosphere.ResourceProperties
data OrchestratorProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-cluster-orchestrator.html>
    OrchestratorProperty {OrchestratorProperty -> ()
haddock_workaround_ :: (),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-cluster-orchestrator.html#cfn-sagemaker-cluster-orchestrator-eks>
                          OrchestratorProperty -> ClusterOrchestratorEksConfigProperty
eks :: ClusterOrchestratorEksConfigProperty}
  deriving stock (OrchestratorProperty -> OrchestratorProperty -> Bool
(OrchestratorProperty -> OrchestratorProperty -> Bool)
-> (OrchestratorProperty -> OrchestratorProperty -> Bool)
-> Eq OrchestratorProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrchestratorProperty -> OrchestratorProperty -> Bool
== :: OrchestratorProperty -> OrchestratorProperty -> Bool
$c/= :: OrchestratorProperty -> OrchestratorProperty -> Bool
/= :: OrchestratorProperty -> OrchestratorProperty -> Bool
Prelude.Eq, Int -> OrchestratorProperty -> ShowS
[OrchestratorProperty] -> ShowS
OrchestratorProperty -> String
(Int -> OrchestratorProperty -> ShowS)
-> (OrchestratorProperty -> String)
-> ([OrchestratorProperty] -> ShowS)
-> Show OrchestratorProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrchestratorProperty -> ShowS
showsPrec :: Int -> OrchestratorProperty -> ShowS
$cshow :: OrchestratorProperty -> String
show :: OrchestratorProperty -> String
$cshowList :: [OrchestratorProperty] -> ShowS
showList :: [OrchestratorProperty] -> ShowS
Prelude.Show)
mkOrchestratorProperty ::
  ClusterOrchestratorEksConfigProperty -> OrchestratorProperty
mkOrchestratorProperty :: ClusterOrchestratorEksConfigProperty -> OrchestratorProperty
mkOrchestratorProperty ClusterOrchestratorEksConfigProperty
eks
  = OrchestratorProperty {haddock_workaround_ :: ()
haddock_workaround_ = (), eks :: ClusterOrchestratorEksConfigProperty
eks = ClusterOrchestratorEksConfigProperty
eks}
instance ToResourceProperties OrchestratorProperty where
  toResourceProperties :: OrchestratorProperty -> ResourceProperties
toResourceProperties OrchestratorProperty {()
ClusterOrchestratorEksConfigProperty
haddock_workaround_ :: OrchestratorProperty -> ()
eks :: OrchestratorProperty -> ClusterOrchestratorEksConfigProperty
haddock_workaround_ :: ()
eks :: ClusterOrchestratorEksConfigProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::SageMaker::Cluster.Orchestrator",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False, properties :: Object
properties = [Key
"Eks" Key -> ClusterOrchestratorEksConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ClusterOrchestratorEksConfigProperty
eks]}
instance JSON.ToJSON OrchestratorProperty where
  toJSON :: OrchestratorProperty -> Value
toJSON OrchestratorProperty {()
ClusterOrchestratorEksConfigProperty
haddock_workaround_ :: OrchestratorProperty -> ()
eks :: OrchestratorProperty -> ClusterOrchestratorEksConfigProperty
haddock_workaround_ :: ()
eks :: ClusterOrchestratorEksConfigProperty
..} = [(Key, Value)] -> Value
JSON.object [Key
"Eks" Key -> ClusterOrchestratorEksConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ClusterOrchestratorEksConfigProperty
eks]
instance Property "Eks" OrchestratorProperty where
  type PropertyType "Eks" OrchestratorProperty = ClusterOrchestratorEksConfigProperty
  set :: PropertyType "Eks" OrchestratorProperty
-> OrchestratorProperty -> OrchestratorProperty
set PropertyType "Eks" OrchestratorProperty
newValue OrchestratorProperty {()
ClusterOrchestratorEksConfigProperty
haddock_workaround_ :: OrchestratorProperty -> ()
eks :: OrchestratorProperty -> ClusterOrchestratorEksConfigProperty
haddock_workaround_ :: ()
eks :: ClusterOrchestratorEksConfigProperty
..}
    = OrchestratorProperty {eks :: ClusterOrchestratorEksConfigProperty
eks = PropertyType "Eks" OrchestratorProperty
ClusterOrchestratorEksConfigProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}