{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SageMaker.CreateInferenceExperiment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an inference experiment using the configurations specified in
-- the request.
--
-- Use this API to setup and schedule an experiment to compare model
-- variants on a Amazon SageMaker inference endpoint. For more information
-- about inference experiments, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/shadow-tests.html Shadow tests>.
--
-- Amazon SageMaker begins your experiment at the scheduled time and routes
-- traffic to your endpoint\'s model variants based on your specified
-- configuration.
--
-- While the experiment is in progress or after it has concluded, you can
-- view metrics that compare your model variants. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/shadow-tests-view-monitor-edit.html View, monitor, and edit shadow tests>.
module Amazonka.SageMaker.CreateInferenceExperiment
  ( -- * Creating a Request
    CreateInferenceExperiment (..),
    newCreateInferenceExperiment,

    -- * Request Lenses
    createInferenceExperiment_dataStorageConfig,
    createInferenceExperiment_description,
    createInferenceExperiment_kmsKey,
    createInferenceExperiment_schedule,
    createInferenceExperiment_tags,
    createInferenceExperiment_name,
    createInferenceExperiment_type,
    createInferenceExperiment_roleArn,
    createInferenceExperiment_endpointName,
    createInferenceExperiment_modelVariants,
    createInferenceExperiment_shadowModeConfig,

    -- * Destructuring the Response
    CreateInferenceExperimentResponse (..),
    newCreateInferenceExperimentResponse,

    -- * Response Lenses
    createInferenceExperimentResponse_httpStatus,
    createInferenceExperimentResponse_inferenceExperimentArn,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SageMaker.Types

-- | /See:/ 'newCreateInferenceExperiment' smart constructor.
data CreateInferenceExperiment = CreateInferenceExperiment'
  { -- | The Amazon S3 location and configuration for storing inference request
    -- and response data.
    --
    -- This is an optional parameter that you can use for data capture. For
    -- more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/model-monitor-data-capture.html Capture data>.
    CreateInferenceExperiment
-> Maybe InferenceExperimentDataStorageConfig
dataStorageConfig :: Prelude.Maybe InferenceExperimentDataStorageConfig,
    -- | A description for the inference experiment.
    CreateInferenceExperiment -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services Key Management Service (Amazon Web Services KMS)
    -- key that Amazon SageMaker uses to encrypt data on the storage volume
    -- attached to the ML compute instance that hosts the endpoint. The
    -- @KmsKey@ can be any of the following formats:
    --
    -- -   KMS key ID
    --
    --     @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
    --
    -- -   Amazon Resource Name (ARN) of a KMS key
    --
    --     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
    --
    -- -   KMS key Alias
    --
    --     @\"alias\/ExampleAlias\"@
    --
    -- -   Amazon Resource Name (ARN) of a KMS key Alias
    --
    --     @\"arn:aws:kms:us-west-2:111122223333:alias\/ExampleAlias\"@
    --
    -- If you use a KMS key ID or an alias of your KMS key, the Amazon
    -- SageMaker execution role must include permissions to call @kms:Encrypt@.
    -- If you don\'t provide a KMS key ID, Amazon SageMaker uses the default
    -- KMS key for Amazon S3 for your role\'s account. Amazon SageMaker uses
    -- server-side encryption with KMS managed keys for @OutputDataConfig@. If
    -- you use a bucket policy with an @s3:PutObject@ permission that only
    -- allows objects with server-side encryption, set the condition key of
    -- @s3:x-amz-server-side-encryption@ to @\"aws:kms\"@. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingKMSEncryption.html KMS managed Encryption Keys>
    -- in the /Amazon Simple Storage Service Developer Guide./
    --
    -- The KMS key policy must grant permission to the IAM role that you
    -- specify in your @CreateEndpoint@ and @UpdateEndpoint@ requests. For more
    -- information, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/key-policies.html Using Key Policies in Amazon Web Services KMS>
    -- in the /Amazon Web Services Key Management Service Developer Guide/.
    CreateInferenceExperiment -> Maybe Text
kmsKey :: Prelude.Maybe Prelude.Text,
    -- | The duration for which you want the inference experiment to run. If you
    -- don\'t specify this field, the experiment automatically starts
    -- immediately upon creation and concludes after 7 days.
    CreateInferenceExperiment -> Maybe InferenceExperimentSchedule
schedule :: Prelude.Maybe InferenceExperimentSchedule,
    -- | Array of key-value pairs. You can use tags to categorize your Amazon Web
    -- Services resources in different ways, for example, by purpose, owner, or
    -- environment. For more information, see
    -- <https://docs.aws.amazon.com/ARG/latest/userguide/tagging.html Tagging your Amazon Web Services Resources>.
    CreateInferenceExperiment -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name for the inference experiment.
    CreateInferenceExperiment -> Text
name :: Prelude.Text,
    -- | The type of the inference experiment that you want to run. The following
    -- types of experiments are possible:
    --
    -- -   @ShadowMode@: You can use this type to validate a shadow variant.
    --     For more information, see
    --     <https://docs.aws.amazon.com/sagemaker/latest/dg/shadow-tests.html Shadow tests>.
    CreateInferenceExperiment -> InferenceExperimentType
type' :: InferenceExperimentType,
    -- | The ARN of the IAM role that Amazon SageMaker can assume to access model
    -- artifacts and container images, and manage Amazon SageMaker Inference
    -- endpoints for model deployment.
    CreateInferenceExperiment -> Text
roleArn :: Prelude.Text,
    -- | The name of the Amazon SageMaker endpoint on which you want to run the
    -- inference experiment.
    CreateInferenceExperiment -> Text
endpointName :: Prelude.Text,
    -- | An array of @ModelVariantConfig@ objects. There is one for each variant
    -- in the inference experiment. Each @ModelVariantConfig@ object in the
    -- array describes the infrastructure configuration for the corresponding
    -- variant.
    CreateInferenceExperiment -> NonEmpty ModelVariantConfig
modelVariants :: Prelude.NonEmpty ModelVariantConfig,
    -- | The configuration of @ShadowMode@ inference experiment type. Use this
    -- field to specify a production variant which takes all the inference
    -- requests, and a shadow variant to which Amazon SageMaker replicates a
    -- percentage of the inference requests. For the shadow variant also
    -- specify the percentage of requests that Amazon SageMaker replicates.
    CreateInferenceExperiment -> ShadowModeConfig
shadowModeConfig :: ShadowModeConfig
  }
  deriving (CreateInferenceExperiment -> CreateInferenceExperiment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInferenceExperiment -> CreateInferenceExperiment -> Bool
$c/= :: CreateInferenceExperiment -> CreateInferenceExperiment -> Bool
== :: CreateInferenceExperiment -> CreateInferenceExperiment -> Bool
$c== :: CreateInferenceExperiment -> CreateInferenceExperiment -> Bool
Prelude.Eq, ReadPrec [CreateInferenceExperiment]
ReadPrec CreateInferenceExperiment
Int -> ReadS CreateInferenceExperiment
ReadS [CreateInferenceExperiment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInferenceExperiment]
$creadListPrec :: ReadPrec [CreateInferenceExperiment]
readPrec :: ReadPrec CreateInferenceExperiment
$creadPrec :: ReadPrec CreateInferenceExperiment
readList :: ReadS [CreateInferenceExperiment]
$creadList :: ReadS [CreateInferenceExperiment]
readsPrec :: Int -> ReadS CreateInferenceExperiment
$creadsPrec :: Int -> ReadS CreateInferenceExperiment
Prelude.Read, Int -> CreateInferenceExperiment -> ShowS
[CreateInferenceExperiment] -> ShowS
CreateInferenceExperiment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInferenceExperiment] -> ShowS
$cshowList :: [CreateInferenceExperiment] -> ShowS
show :: CreateInferenceExperiment -> String
$cshow :: CreateInferenceExperiment -> String
showsPrec :: Int -> CreateInferenceExperiment -> ShowS
$cshowsPrec :: Int -> CreateInferenceExperiment -> ShowS
Prelude.Show, forall x.
Rep CreateInferenceExperiment x -> CreateInferenceExperiment
forall x.
CreateInferenceExperiment -> Rep CreateInferenceExperiment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateInferenceExperiment x -> CreateInferenceExperiment
$cfrom :: forall x.
CreateInferenceExperiment -> Rep CreateInferenceExperiment x
Prelude.Generic)

-- |
-- Create a value of 'CreateInferenceExperiment' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'dataStorageConfig', 'createInferenceExperiment_dataStorageConfig' - The Amazon S3 location and configuration for storing inference request
-- and response data.
--
-- This is an optional parameter that you can use for data capture. For
-- more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/model-monitor-data-capture.html Capture data>.
--
-- 'description', 'createInferenceExperiment_description' - A description for the inference experiment.
--
-- 'kmsKey', 'createInferenceExperiment_kmsKey' - The Amazon Web Services Key Management Service (Amazon Web Services KMS)
-- key that Amazon SageMaker uses to encrypt data on the storage volume
-- attached to the ML compute instance that hosts the endpoint. The
-- @KmsKey@ can be any of the following formats:
--
-- -   KMS key ID
--
--     @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS key
--
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   KMS key Alias
--
--     @\"alias\/ExampleAlias\"@
--
-- -   Amazon Resource Name (ARN) of a KMS key Alias
--
--     @\"arn:aws:kms:us-west-2:111122223333:alias\/ExampleAlias\"@
--
-- If you use a KMS key ID or an alias of your KMS key, the Amazon
-- SageMaker execution role must include permissions to call @kms:Encrypt@.
-- If you don\'t provide a KMS key ID, Amazon SageMaker uses the default
-- KMS key for Amazon S3 for your role\'s account. Amazon SageMaker uses
-- server-side encryption with KMS managed keys for @OutputDataConfig@. If
-- you use a bucket policy with an @s3:PutObject@ permission that only
-- allows objects with server-side encryption, set the condition key of
-- @s3:x-amz-server-side-encryption@ to @\"aws:kms\"@. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingKMSEncryption.html KMS managed Encryption Keys>
-- in the /Amazon Simple Storage Service Developer Guide./
--
-- The KMS key policy must grant permission to the IAM role that you
-- specify in your @CreateEndpoint@ and @UpdateEndpoint@ requests. For more
-- information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/key-policies.html Using Key Policies in Amazon Web Services KMS>
-- in the /Amazon Web Services Key Management Service Developer Guide/.
--
-- 'schedule', 'createInferenceExperiment_schedule' - The duration for which you want the inference experiment to run. If you
-- don\'t specify this field, the experiment automatically starts
-- immediately upon creation and concludes after 7 days.
--
-- 'tags', 'createInferenceExperiment_tags' - Array of key-value pairs. You can use tags to categorize your Amazon Web
-- Services resources in different ways, for example, by purpose, owner, or
-- environment. For more information, see
-- <https://docs.aws.amazon.com/ARG/latest/userguide/tagging.html Tagging your Amazon Web Services Resources>.
--
-- 'name', 'createInferenceExperiment_name' - The name for the inference experiment.
--
-- 'type'', 'createInferenceExperiment_type' - The type of the inference experiment that you want to run. The following
-- types of experiments are possible:
--
-- -   @ShadowMode@: You can use this type to validate a shadow variant.
--     For more information, see
--     <https://docs.aws.amazon.com/sagemaker/latest/dg/shadow-tests.html Shadow tests>.
--
-- 'roleArn', 'createInferenceExperiment_roleArn' - The ARN of the IAM role that Amazon SageMaker can assume to access model
-- artifacts and container images, and manage Amazon SageMaker Inference
-- endpoints for model deployment.
--
-- 'endpointName', 'createInferenceExperiment_endpointName' - The name of the Amazon SageMaker endpoint on which you want to run the
-- inference experiment.
--
-- 'modelVariants', 'createInferenceExperiment_modelVariants' - An array of @ModelVariantConfig@ objects. There is one for each variant
-- in the inference experiment. Each @ModelVariantConfig@ object in the
-- array describes the infrastructure configuration for the corresponding
-- variant.
--
-- 'shadowModeConfig', 'createInferenceExperiment_shadowModeConfig' - The configuration of @ShadowMode@ inference experiment type. Use this
-- field to specify a production variant which takes all the inference
-- requests, and a shadow variant to which Amazon SageMaker replicates a
-- percentage of the inference requests. For the shadow variant also
-- specify the percentage of requests that Amazon SageMaker replicates.
newCreateInferenceExperiment ::
  -- | 'name'
  Prelude.Text ->
  -- | 'type''
  InferenceExperimentType ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'endpointName'
  Prelude.Text ->
  -- | 'modelVariants'
  Prelude.NonEmpty ModelVariantConfig ->
  -- | 'shadowModeConfig'
  ShadowModeConfig ->
  CreateInferenceExperiment
newCreateInferenceExperiment :: Text
-> InferenceExperimentType
-> Text
-> Text
-> NonEmpty ModelVariantConfig
-> ShadowModeConfig
-> CreateInferenceExperiment
newCreateInferenceExperiment
  Text
pName_
  InferenceExperimentType
pType_
  Text
pRoleArn_
  Text
pEndpointName_
  NonEmpty ModelVariantConfig
pModelVariants_
  ShadowModeConfig
pShadowModeConfig_ =
    CreateInferenceExperiment'
      { $sel:dataStorageConfig:CreateInferenceExperiment' :: Maybe InferenceExperimentDataStorageConfig
dataStorageConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateInferenceExperiment' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKey:CreateInferenceExperiment' :: Maybe Text
kmsKey = forall a. Maybe a
Prelude.Nothing,
        $sel:schedule:CreateInferenceExperiment' :: Maybe InferenceExperimentSchedule
schedule = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateInferenceExperiment' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateInferenceExperiment' :: Text
name = Text
pName_,
        $sel:type':CreateInferenceExperiment' :: InferenceExperimentType
type' = InferenceExperimentType
pType_,
        $sel:roleArn:CreateInferenceExperiment' :: Text
roleArn = Text
pRoleArn_,
        $sel:endpointName:CreateInferenceExperiment' :: Text
endpointName = Text
pEndpointName_,
        $sel:modelVariants:CreateInferenceExperiment' :: NonEmpty ModelVariantConfig
modelVariants =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty ModelVariantConfig
pModelVariants_,
        $sel:shadowModeConfig:CreateInferenceExperiment' :: ShadowModeConfig
shadowModeConfig = ShadowModeConfig
pShadowModeConfig_
      }

-- | The Amazon S3 location and configuration for storing inference request
-- and response data.
--
-- This is an optional parameter that you can use for data capture. For
-- more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/model-monitor-data-capture.html Capture data>.
createInferenceExperiment_dataStorageConfig :: Lens.Lens' CreateInferenceExperiment (Prelude.Maybe InferenceExperimentDataStorageConfig)
createInferenceExperiment_dataStorageConfig :: Lens'
  CreateInferenceExperiment
  (Maybe InferenceExperimentDataStorageConfig)
createInferenceExperiment_dataStorageConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Maybe InferenceExperimentDataStorageConfig
dataStorageConfig :: Maybe InferenceExperimentDataStorageConfig
$sel:dataStorageConfig:CreateInferenceExperiment' :: CreateInferenceExperiment
-> Maybe InferenceExperimentDataStorageConfig
dataStorageConfig} -> Maybe InferenceExperimentDataStorageConfig
dataStorageConfig) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Maybe InferenceExperimentDataStorageConfig
a -> CreateInferenceExperiment
s {$sel:dataStorageConfig:CreateInferenceExperiment' :: Maybe InferenceExperimentDataStorageConfig
dataStorageConfig = Maybe InferenceExperimentDataStorageConfig
a} :: CreateInferenceExperiment)

-- | A description for the inference experiment.
createInferenceExperiment_description :: Lens.Lens' CreateInferenceExperiment (Prelude.Maybe Prelude.Text)
createInferenceExperiment_description :: Lens' CreateInferenceExperiment (Maybe Text)
createInferenceExperiment_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Maybe Text
description :: Maybe Text
$sel:description:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Maybe Text
a -> CreateInferenceExperiment
s {$sel:description:CreateInferenceExperiment' :: Maybe Text
description = Maybe Text
a} :: CreateInferenceExperiment)

-- | The Amazon Web Services Key Management Service (Amazon Web Services KMS)
-- key that Amazon SageMaker uses to encrypt data on the storage volume
-- attached to the ML compute instance that hosts the endpoint. The
-- @KmsKey@ can be any of the following formats:
--
-- -   KMS key ID
--
--     @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS key
--
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   KMS key Alias
--
--     @\"alias\/ExampleAlias\"@
--
-- -   Amazon Resource Name (ARN) of a KMS key Alias
--
--     @\"arn:aws:kms:us-west-2:111122223333:alias\/ExampleAlias\"@
--
-- If you use a KMS key ID or an alias of your KMS key, the Amazon
-- SageMaker execution role must include permissions to call @kms:Encrypt@.
-- If you don\'t provide a KMS key ID, Amazon SageMaker uses the default
-- KMS key for Amazon S3 for your role\'s account. Amazon SageMaker uses
-- server-side encryption with KMS managed keys for @OutputDataConfig@. If
-- you use a bucket policy with an @s3:PutObject@ permission that only
-- allows objects with server-side encryption, set the condition key of
-- @s3:x-amz-server-side-encryption@ to @\"aws:kms\"@. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingKMSEncryption.html KMS managed Encryption Keys>
-- in the /Amazon Simple Storage Service Developer Guide./
--
-- The KMS key policy must grant permission to the IAM role that you
-- specify in your @CreateEndpoint@ and @UpdateEndpoint@ requests. For more
-- information, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/key-policies.html Using Key Policies in Amazon Web Services KMS>
-- in the /Amazon Web Services Key Management Service Developer Guide/.
createInferenceExperiment_kmsKey :: Lens.Lens' CreateInferenceExperiment (Prelude.Maybe Prelude.Text)
createInferenceExperiment_kmsKey :: Lens' CreateInferenceExperiment (Maybe Text)
createInferenceExperiment_kmsKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Maybe Text
kmsKey :: Maybe Text
$sel:kmsKey:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
kmsKey} -> Maybe Text
kmsKey) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Maybe Text
a -> CreateInferenceExperiment
s {$sel:kmsKey:CreateInferenceExperiment' :: Maybe Text
kmsKey = Maybe Text
a} :: CreateInferenceExperiment)

-- | The duration for which you want the inference experiment to run. If you
-- don\'t specify this field, the experiment automatically starts
-- immediately upon creation and concludes after 7 days.
createInferenceExperiment_schedule :: Lens.Lens' CreateInferenceExperiment (Prelude.Maybe InferenceExperimentSchedule)
createInferenceExperiment_schedule :: Lens' CreateInferenceExperiment (Maybe InferenceExperimentSchedule)
createInferenceExperiment_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Maybe InferenceExperimentSchedule
schedule :: Maybe InferenceExperimentSchedule
$sel:schedule:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe InferenceExperimentSchedule
schedule} -> Maybe InferenceExperimentSchedule
schedule) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Maybe InferenceExperimentSchedule
a -> CreateInferenceExperiment
s {$sel:schedule:CreateInferenceExperiment' :: Maybe InferenceExperimentSchedule
schedule = Maybe InferenceExperimentSchedule
a} :: CreateInferenceExperiment)

-- | Array of key-value pairs. You can use tags to categorize your Amazon Web
-- Services resources in different ways, for example, by purpose, owner, or
-- environment. For more information, see
-- <https://docs.aws.amazon.com/ARG/latest/userguide/tagging.html Tagging your Amazon Web Services Resources>.
createInferenceExperiment_tags :: Lens.Lens' CreateInferenceExperiment (Prelude.Maybe [Tag])
createInferenceExperiment_tags :: Lens' CreateInferenceExperiment (Maybe [Tag])
createInferenceExperiment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Maybe [Tag]
a -> CreateInferenceExperiment
s {$sel:tags:CreateInferenceExperiment' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateInferenceExperiment) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name for the inference experiment.
createInferenceExperiment_name :: Lens.Lens' CreateInferenceExperiment Prelude.Text
createInferenceExperiment_name :: Lens' CreateInferenceExperiment Text
createInferenceExperiment_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Text
name :: Text
$sel:name:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
name} -> Text
name) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Text
a -> CreateInferenceExperiment
s {$sel:name:CreateInferenceExperiment' :: Text
name = Text
a} :: CreateInferenceExperiment)

-- | The type of the inference experiment that you want to run. The following
-- types of experiments are possible:
--
-- -   @ShadowMode@: You can use this type to validate a shadow variant.
--     For more information, see
--     <https://docs.aws.amazon.com/sagemaker/latest/dg/shadow-tests.html Shadow tests>.
createInferenceExperiment_type :: Lens.Lens' CreateInferenceExperiment InferenceExperimentType
createInferenceExperiment_type :: Lens' CreateInferenceExperiment InferenceExperimentType
createInferenceExperiment_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {InferenceExperimentType
type' :: InferenceExperimentType
$sel:type':CreateInferenceExperiment' :: CreateInferenceExperiment -> InferenceExperimentType
type'} -> InferenceExperimentType
type') (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} InferenceExperimentType
a -> CreateInferenceExperiment
s {$sel:type':CreateInferenceExperiment' :: InferenceExperimentType
type' = InferenceExperimentType
a} :: CreateInferenceExperiment)

-- | The ARN of the IAM role that Amazon SageMaker can assume to access model
-- artifacts and container images, and manage Amazon SageMaker Inference
-- endpoints for model deployment.
createInferenceExperiment_roleArn :: Lens.Lens' CreateInferenceExperiment Prelude.Text
createInferenceExperiment_roleArn :: Lens' CreateInferenceExperiment Text
createInferenceExperiment_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Text
roleArn :: Text
$sel:roleArn:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
roleArn} -> Text
roleArn) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Text
a -> CreateInferenceExperiment
s {$sel:roleArn:CreateInferenceExperiment' :: Text
roleArn = Text
a} :: CreateInferenceExperiment)

-- | The name of the Amazon SageMaker endpoint on which you want to run the
-- inference experiment.
createInferenceExperiment_endpointName :: Lens.Lens' CreateInferenceExperiment Prelude.Text
createInferenceExperiment_endpointName :: Lens' CreateInferenceExperiment Text
createInferenceExperiment_endpointName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {Text
endpointName :: Text
$sel:endpointName:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
endpointName} -> Text
endpointName) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} Text
a -> CreateInferenceExperiment
s {$sel:endpointName:CreateInferenceExperiment' :: Text
endpointName = Text
a} :: CreateInferenceExperiment)

-- | An array of @ModelVariantConfig@ objects. There is one for each variant
-- in the inference experiment. Each @ModelVariantConfig@ object in the
-- array describes the infrastructure configuration for the corresponding
-- variant.
createInferenceExperiment_modelVariants :: Lens.Lens' CreateInferenceExperiment (Prelude.NonEmpty ModelVariantConfig)
createInferenceExperiment_modelVariants :: Lens' CreateInferenceExperiment (NonEmpty ModelVariantConfig)
createInferenceExperiment_modelVariants = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {NonEmpty ModelVariantConfig
modelVariants :: NonEmpty ModelVariantConfig
$sel:modelVariants:CreateInferenceExperiment' :: CreateInferenceExperiment -> NonEmpty ModelVariantConfig
modelVariants} -> NonEmpty ModelVariantConfig
modelVariants) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} NonEmpty ModelVariantConfig
a -> CreateInferenceExperiment
s {$sel:modelVariants:CreateInferenceExperiment' :: NonEmpty ModelVariantConfig
modelVariants = NonEmpty ModelVariantConfig
a} :: CreateInferenceExperiment) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The configuration of @ShadowMode@ inference experiment type. Use this
-- field to specify a production variant which takes all the inference
-- requests, and a shadow variant to which Amazon SageMaker replicates a
-- percentage of the inference requests. For the shadow variant also
-- specify the percentage of requests that Amazon SageMaker replicates.
createInferenceExperiment_shadowModeConfig :: Lens.Lens' CreateInferenceExperiment ShadowModeConfig
createInferenceExperiment_shadowModeConfig :: Lens' CreateInferenceExperiment ShadowModeConfig
createInferenceExperiment_shadowModeConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperiment' {ShadowModeConfig
shadowModeConfig :: ShadowModeConfig
$sel:shadowModeConfig:CreateInferenceExperiment' :: CreateInferenceExperiment -> ShadowModeConfig
shadowModeConfig} -> ShadowModeConfig
shadowModeConfig) (\s :: CreateInferenceExperiment
s@CreateInferenceExperiment' {} ShadowModeConfig
a -> CreateInferenceExperiment
s {$sel:shadowModeConfig:CreateInferenceExperiment' :: ShadowModeConfig
shadowModeConfig = ShadowModeConfig
a} :: CreateInferenceExperiment)

instance Core.AWSRequest CreateInferenceExperiment where
  type
    AWSResponse CreateInferenceExperiment =
      CreateInferenceExperimentResponse
  request :: (Service -> Service)
-> CreateInferenceExperiment -> Request CreateInferenceExperiment
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateInferenceExperiment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateInferenceExperiment)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> CreateInferenceExperimentResponse
CreateInferenceExperimentResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"InferenceExperimentArn")
      )

instance Prelude.Hashable CreateInferenceExperiment where
  hashWithSalt :: Int -> CreateInferenceExperiment -> Int
hashWithSalt Int
_salt CreateInferenceExperiment' {Maybe [Tag]
Maybe Text
Maybe InferenceExperimentDataStorageConfig
Maybe InferenceExperimentSchedule
NonEmpty ModelVariantConfig
Text
InferenceExperimentType
ShadowModeConfig
shadowModeConfig :: ShadowModeConfig
modelVariants :: NonEmpty ModelVariantConfig
endpointName :: Text
roleArn :: Text
type' :: InferenceExperimentType
name :: Text
tags :: Maybe [Tag]
schedule :: Maybe InferenceExperimentSchedule
kmsKey :: Maybe Text
description :: Maybe Text
dataStorageConfig :: Maybe InferenceExperimentDataStorageConfig
$sel:shadowModeConfig:CreateInferenceExperiment' :: CreateInferenceExperiment -> ShadowModeConfig
$sel:modelVariants:CreateInferenceExperiment' :: CreateInferenceExperiment -> NonEmpty ModelVariantConfig
$sel:endpointName:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:roleArn:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:type':CreateInferenceExperiment' :: CreateInferenceExperiment -> InferenceExperimentType
$sel:name:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:tags:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe [Tag]
$sel:schedule:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe InferenceExperimentSchedule
$sel:kmsKey:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
$sel:description:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
$sel:dataStorageConfig:CreateInferenceExperiment' :: CreateInferenceExperiment
-> Maybe InferenceExperimentDataStorageConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InferenceExperimentDataStorageConfig
dataStorageConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InferenceExperimentSchedule
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InferenceExperimentType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ModelVariantConfig
modelVariants
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ShadowModeConfig
shadowModeConfig

instance Prelude.NFData CreateInferenceExperiment where
  rnf :: CreateInferenceExperiment -> ()
rnf CreateInferenceExperiment' {Maybe [Tag]
Maybe Text
Maybe InferenceExperimentDataStorageConfig
Maybe InferenceExperimentSchedule
NonEmpty ModelVariantConfig
Text
InferenceExperimentType
ShadowModeConfig
shadowModeConfig :: ShadowModeConfig
modelVariants :: NonEmpty ModelVariantConfig
endpointName :: Text
roleArn :: Text
type' :: InferenceExperimentType
name :: Text
tags :: Maybe [Tag]
schedule :: Maybe InferenceExperimentSchedule
kmsKey :: Maybe Text
description :: Maybe Text
dataStorageConfig :: Maybe InferenceExperimentDataStorageConfig
$sel:shadowModeConfig:CreateInferenceExperiment' :: CreateInferenceExperiment -> ShadowModeConfig
$sel:modelVariants:CreateInferenceExperiment' :: CreateInferenceExperiment -> NonEmpty ModelVariantConfig
$sel:endpointName:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:roleArn:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:type':CreateInferenceExperiment' :: CreateInferenceExperiment -> InferenceExperimentType
$sel:name:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:tags:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe [Tag]
$sel:schedule:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe InferenceExperimentSchedule
$sel:kmsKey:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
$sel:description:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
$sel:dataStorageConfig:CreateInferenceExperiment' :: CreateInferenceExperiment
-> Maybe InferenceExperimentDataStorageConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InferenceExperimentDataStorageConfig
dataStorageConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InferenceExperimentSchedule
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InferenceExperimentType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
endpointName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ModelVariantConfig
modelVariants
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ShadowModeConfig
shadowModeConfig

instance Data.ToHeaders CreateInferenceExperiment where
  toHeaders :: CreateInferenceExperiment -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"SageMaker.CreateInferenceExperiment" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateInferenceExperiment where
  toJSON :: CreateInferenceExperiment -> Value
toJSON CreateInferenceExperiment' {Maybe [Tag]
Maybe Text
Maybe InferenceExperimentDataStorageConfig
Maybe InferenceExperimentSchedule
NonEmpty ModelVariantConfig
Text
InferenceExperimentType
ShadowModeConfig
shadowModeConfig :: ShadowModeConfig
modelVariants :: NonEmpty ModelVariantConfig
endpointName :: Text
roleArn :: Text
type' :: InferenceExperimentType
name :: Text
tags :: Maybe [Tag]
schedule :: Maybe InferenceExperimentSchedule
kmsKey :: Maybe Text
description :: Maybe Text
dataStorageConfig :: Maybe InferenceExperimentDataStorageConfig
$sel:shadowModeConfig:CreateInferenceExperiment' :: CreateInferenceExperiment -> ShadowModeConfig
$sel:modelVariants:CreateInferenceExperiment' :: CreateInferenceExperiment -> NonEmpty ModelVariantConfig
$sel:endpointName:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:roleArn:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:type':CreateInferenceExperiment' :: CreateInferenceExperiment -> InferenceExperimentType
$sel:name:CreateInferenceExperiment' :: CreateInferenceExperiment -> Text
$sel:tags:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe [Tag]
$sel:schedule:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe InferenceExperimentSchedule
$sel:kmsKey:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
$sel:description:CreateInferenceExperiment' :: CreateInferenceExperiment -> Maybe Text
$sel:dataStorageConfig:CreateInferenceExperiment' :: CreateInferenceExperiment
-> Maybe InferenceExperimentDataStorageConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataStorageConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe InferenceExperimentDataStorageConfig
dataStorageConfig,
            (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"KmsKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
kmsKey,
            (Key
"Schedule" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe InferenceExperimentSchedule
schedule,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InferenceExperimentType
type'),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"EndpointName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ModelVariants" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ModelVariantConfig
modelVariants),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ShadowModeConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ShadowModeConfig
shadowModeConfig)
          ]
      )

instance Data.ToPath CreateInferenceExperiment where
  toPath :: CreateInferenceExperiment -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery CreateInferenceExperiment where
  toQuery :: CreateInferenceExperiment -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateInferenceExperimentResponse' smart constructor.
data CreateInferenceExperimentResponse = CreateInferenceExperimentResponse'
  { -- | The response's http status code.
    CreateInferenceExperimentResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ARN for your inference experiment.
    CreateInferenceExperimentResponse -> Text
inferenceExperimentArn :: Prelude.Text
  }
  deriving (CreateInferenceExperimentResponse
-> CreateInferenceExperimentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateInferenceExperimentResponse
-> CreateInferenceExperimentResponse -> Bool
$c/= :: CreateInferenceExperimentResponse
-> CreateInferenceExperimentResponse -> Bool
== :: CreateInferenceExperimentResponse
-> CreateInferenceExperimentResponse -> Bool
$c== :: CreateInferenceExperimentResponse
-> CreateInferenceExperimentResponse -> Bool
Prelude.Eq, ReadPrec [CreateInferenceExperimentResponse]
ReadPrec CreateInferenceExperimentResponse
Int -> ReadS CreateInferenceExperimentResponse
ReadS [CreateInferenceExperimentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateInferenceExperimentResponse]
$creadListPrec :: ReadPrec [CreateInferenceExperimentResponse]
readPrec :: ReadPrec CreateInferenceExperimentResponse
$creadPrec :: ReadPrec CreateInferenceExperimentResponse
readList :: ReadS [CreateInferenceExperimentResponse]
$creadList :: ReadS [CreateInferenceExperimentResponse]
readsPrec :: Int -> ReadS CreateInferenceExperimentResponse
$creadsPrec :: Int -> ReadS CreateInferenceExperimentResponse
Prelude.Read, Int -> CreateInferenceExperimentResponse -> ShowS
[CreateInferenceExperimentResponse] -> ShowS
CreateInferenceExperimentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateInferenceExperimentResponse] -> ShowS
$cshowList :: [CreateInferenceExperimentResponse] -> ShowS
show :: CreateInferenceExperimentResponse -> String
$cshow :: CreateInferenceExperimentResponse -> String
showsPrec :: Int -> CreateInferenceExperimentResponse -> ShowS
$cshowsPrec :: Int -> CreateInferenceExperimentResponse -> ShowS
Prelude.Show, forall x.
Rep CreateInferenceExperimentResponse x
-> CreateInferenceExperimentResponse
forall x.
CreateInferenceExperimentResponse
-> Rep CreateInferenceExperimentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateInferenceExperimentResponse x
-> CreateInferenceExperimentResponse
$cfrom :: forall x.
CreateInferenceExperimentResponse
-> Rep CreateInferenceExperimentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateInferenceExperimentResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'createInferenceExperimentResponse_httpStatus' - The response's http status code.
--
-- 'inferenceExperimentArn', 'createInferenceExperimentResponse_inferenceExperimentArn' - The ARN for your inference experiment.
newCreateInferenceExperimentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'inferenceExperimentArn'
  Prelude.Text ->
  CreateInferenceExperimentResponse
newCreateInferenceExperimentResponse :: Int -> Text -> CreateInferenceExperimentResponse
newCreateInferenceExperimentResponse
  Int
pHttpStatus_
  Text
pInferenceExperimentArn_ =
    CreateInferenceExperimentResponse'
      { $sel:httpStatus:CreateInferenceExperimentResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:inferenceExperimentArn:CreateInferenceExperimentResponse' :: Text
inferenceExperimentArn =
          Text
pInferenceExperimentArn_
      }

-- | The response's http status code.
createInferenceExperimentResponse_httpStatus :: Lens.Lens' CreateInferenceExperimentResponse Prelude.Int
createInferenceExperimentResponse_httpStatus :: Lens' CreateInferenceExperimentResponse Int
createInferenceExperimentResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperimentResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateInferenceExperimentResponse' :: CreateInferenceExperimentResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateInferenceExperimentResponse
s@CreateInferenceExperimentResponse' {} Int
a -> CreateInferenceExperimentResponse
s {$sel:httpStatus:CreateInferenceExperimentResponse' :: Int
httpStatus = Int
a} :: CreateInferenceExperimentResponse)

-- | The ARN for your inference experiment.
createInferenceExperimentResponse_inferenceExperimentArn :: Lens.Lens' CreateInferenceExperimentResponse Prelude.Text
createInferenceExperimentResponse_inferenceExperimentArn :: Lens' CreateInferenceExperimentResponse Text
createInferenceExperimentResponse_inferenceExperimentArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateInferenceExperimentResponse' {Text
inferenceExperimentArn :: Text
$sel:inferenceExperimentArn:CreateInferenceExperimentResponse' :: CreateInferenceExperimentResponse -> Text
inferenceExperimentArn} -> Text
inferenceExperimentArn) (\s :: CreateInferenceExperimentResponse
s@CreateInferenceExperimentResponse' {} Text
a -> CreateInferenceExperimentResponse
s {$sel:inferenceExperimentArn:CreateInferenceExperimentResponse' :: Text
inferenceExperimentArn = Text
a} :: CreateInferenceExperimentResponse)

instance
  Prelude.NFData
    CreateInferenceExperimentResponse
  where
  rnf :: CreateInferenceExperimentResponse -> ()
rnf CreateInferenceExperimentResponse' {Int
Text
inferenceExperimentArn :: Text
httpStatus :: Int
$sel:inferenceExperimentArn:CreateInferenceExperimentResponse' :: CreateInferenceExperimentResponse -> Text
$sel:httpStatus:CreateInferenceExperimentResponse' :: CreateInferenceExperimentResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
inferenceExperimentArn