module Stratosphere.SageMaker.InferenceExperiment.ModelInfrastructureConfigProperty (
        module Exports, ModelInfrastructureConfigProperty(..),
        mkModelInfrastructureConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.SageMaker.InferenceExperiment.RealTimeInferenceConfigProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ModelInfrastructureConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-inferenceexperiment-modelinfrastructureconfig.html>
    ModelInfrastructureConfigProperty {ModelInfrastructureConfigProperty -> ()
haddock_workaround_ :: (),
                                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-inferenceexperiment-modelinfrastructureconfig.html#cfn-sagemaker-inferenceexperiment-modelinfrastructureconfig-infrastructuretype>
                                       ModelInfrastructureConfigProperty -> Value Text
infrastructureType :: (Value Prelude.Text),
                                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sagemaker-inferenceexperiment-modelinfrastructureconfig.html#cfn-sagemaker-inferenceexperiment-modelinfrastructureconfig-realtimeinferenceconfig>
                                       ModelInfrastructureConfigProperty
-> RealTimeInferenceConfigProperty
realTimeInferenceConfig :: RealTimeInferenceConfigProperty}
  deriving stock (ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty -> Bool
(ModelInfrastructureConfigProperty
 -> ModelInfrastructureConfigProperty -> Bool)
-> (ModelInfrastructureConfigProperty
    -> ModelInfrastructureConfigProperty -> Bool)
-> Eq ModelInfrastructureConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty -> Bool
== :: ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty -> Bool
$c/= :: ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty -> Bool
/= :: ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty -> Bool
Prelude.Eq, Int -> ModelInfrastructureConfigProperty -> ShowS
[ModelInfrastructureConfigProperty] -> ShowS
ModelInfrastructureConfigProperty -> String
(Int -> ModelInfrastructureConfigProperty -> ShowS)
-> (ModelInfrastructureConfigProperty -> String)
-> ([ModelInfrastructureConfigProperty] -> ShowS)
-> Show ModelInfrastructureConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelInfrastructureConfigProperty -> ShowS
showsPrec :: Int -> ModelInfrastructureConfigProperty -> ShowS
$cshow :: ModelInfrastructureConfigProperty -> String
show :: ModelInfrastructureConfigProperty -> String
$cshowList :: [ModelInfrastructureConfigProperty] -> ShowS
showList :: [ModelInfrastructureConfigProperty] -> ShowS
Prelude.Show)
mkModelInfrastructureConfigProperty ::
  Value Prelude.Text
  -> RealTimeInferenceConfigProperty
     -> ModelInfrastructureConfigProperty
mkModelInfrastructureConfigProperty :: Value Text
-> RealTimeInferenceConfigProperty
-> ModelInfrastructureConfigProperty
mkModelInfrastructureConfigProperty
  Value Text
infrastructureType
  RealTimeInferenceConfigProperty
realTimeInferenceConfig
  = ModelInfrastructureConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), infrastructureType :: Value Text
infrastructureType = Value Text
infrastructureType,
       realTimeInferenceConfig :: RealTimeInferenceConfigProperty
realTimeInferenceConfig = RealTimeInferenceConfigProperty
realTimeInferenceConfig}
instance ToResourceProperties ModelInfrastructureConfigProperty where
  toResourceProperties :: ModelInfrastructureConfigProperty -> ResourceProperties
toResourceProperties ModelInfrastructureConfigProperty {()
Value Text
RealTimeInferenceConfigProperty
haddock_workaround_ :: ModelInfrastructureConfigProperty -> ()
infrastructureType :: ModelInfrastructureConfigProperty -> Value Text
realTimeInferenceConfig :: ModelInfrastructureConfigProperty
-> RealTimeInferenceConfigProperty
haddock_workaround_ :: ()
infrastructureType :: Value Text
realTimeInferenceConfig :: RealTimeInferenceConfigProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::SageMaker::InferenceExperiment.ModelInfrastructureConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"InfrastructureType" 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
infrastructureType,
                       Key
"RealTimeInferenceConfig" Key -> RealTimeInferenceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= RealTimeInferenceConfigProperty
realTimeInferenceConfig]}
instance JSON.ToJSON ModelInfrastructureConfigProperty where
  toJSON :: ModelInfrastructureConfigProperty -> Value
toJSON ModelInfrastructureConfigProperty {()
Value Text
RealTimeInferenceConfigProperty
haddock_workaround_ :: ModelInfrastructureConfigProperty -> ()
infrastructureType :: ModelInfrastructureConfigProperty -> Value Text
realTimeInferenceConfig :: ModelInfrastructureConfigProperty
-> RealTimeInferenceConfigProperty
haddock_workaround_ :: ()
infrastructureType :: Value Text
realTimeInferenceConfig :: RealTimeInferenceConfigProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"InfrastructureType" 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
infrastructureType,
         Key
"RealTimeInferenceConfig" Key -> RealTimeInferenceConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= RealTimeInferenceConfigProperty
realTimeInferenceConfig]
instance Property "InfrastructureType" ModelInfrastructureConfigProperty where
  type PropertyType "InfrastructureType" ModelInfrastructureConfigProperty = Value Prelude.Text
  set :: PropertyType "InfrastructureType" ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty
set PropertyType "InfrastructureType" ModelInfrastructureConfigProperty
newValue ModelInfrastructureConfigProperty {()
Value Text
RealTimeInferenceConfigProperty
haddock_workaround_ :: ModelInfrastructureConfigProperty -> ()
infrastructureType :: ModelInfrastructureConfigProperty -> Value Text
realTimeInferenceConfig :: ModelInfrastructureConfigProperty
-> RealTimeInferenceConfigProperty
haddock_workaround_ :: ()
infrastructureType :: Value Text
realTimeInferenceConfig :: RealTimeInferenceConfigProperty
..}
    = ModelInfrastructureConfigProperty
        {infrastructureType :: Value Text
infrastructureType = PropertyType "InfrastructureType" ModelInfrastructureConfigProperty
Value Text
newValue, ()
RealTimeInferenceConfigProperty
haddock_workaround_ :: ()
realTimeInferenceConfig :: RealTimeInferenceConfigProperty
haddock_workaround_ :: ()
realTimeInferenceConfig :: RealTimeInferenceConfigProperty
..}
instance Property "RealTimeInferenceConfig" ModelInfrastructureConfigProperty where
  type PropertyType "RealTimeInferenceConfig" ModelInfrastructureConfigProperty = RealTimeInferenceConfigProperty
  set :: PropertyType
  "RealTimeInferenceConfig" ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty
-> ModelInfrastructureConfigProperty
set PropertyType
  "RealTimeInferenceConfig" ModelInfrastructureConfigProperty
newValue ModelInfrastructureConfigProperty {()
Value Text
RealTimeInferenceConfigProperty
haddock_workaround_ :: ModelInfrastructureConfigProperty -> ()
infrastructureType :: ModelInfrastructureConfigProperty -> Value Text
realTimeInferenceConfig :: ModelInfrastructureConfigProperty
-> RealTimeInferenceConfigProperty
haddock_workaround_ :: ()
infrastructureType :: Value Text
realTimeInferenceConfig :: RealTimeInferenceConfigProperty
..}
    = ModelInfrastructureConfigProperty
        {realTimeInferenceConfig :: RealTimeInferenceConfigProperty
realTimeInferenceConfig = PropertyType
  "RealTimeInferenceConfig" ModelInfrastructureConfigProperty
RealTimeInferenceConfigProperty
newValue, ()
Value Text
haddock_workaround_ :: ()
infrastructureType :: Value Text
haddock_workaround_ :: ()
infrastructureType :: Value Text
..}