{-# 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.CreateEndpointConfig
-- 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 endpoint configuration that SageMaker hosting services uses
-- to deploy models. In the configuration, you identify one or more models,
-- created using the @CreateModel@ API, to deploy and the resources that
-- you want SageMaker to provision. Then you call the CreateEndpoint API.
--
-- Use this API if you want to use SageMaker hosting services to deploy
-- models into production.
--
-- In the request, you define a @ProductionVariant@, for each model that
-- you want to deploy. Each @ProductionVariant@ parameter also describes
-- the resources that you want SageMaker to provision. This includes the
-- number and type of ML compute instances to deploy.
--
-- If you are hosting multiple models, you also assign a @VariantWeight@ to
-- specify how much traffic you want to allocate to each model. For
-- example, suppose that you want to host two models, A and B, and you
-- assign traffic weight 2 for model A and 1 for model B. SageMaker
-- distributes two-thirds of the traffic to Model A, and one-third to model
-- B.
--
-- When you call CreateEndpoint, a load call is made to DynamoDB to verify
-- that your endpoint configuration exists. When you read data from a
-- DynamoDB table supporting
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadConsistency.html Eventually Consistent Reads>
-- , the response might not reflect the results of a recently completed
-- write operation. The response might include some stale data. If the
-- dependent entities are not yet in DynamoDB, this causes a validation
-- error. If you repeat your read request after a short time, the response
-- should return the latest data. So retry logic is recommended to handle
-- these possible issues. We also recommend that customers call
-- DescribeEndpointConfig before calling CreateEndpoint to minimize the
-- potential impact of a DynamoDB eventually consistent read.
module Amazonka.SageMaker.CreateEndpointConfig
  ( -- * Creating a Request
    CreateEndpointConfig (..),
    newCreateEndpointConfig,

    -- * Request Lenses
    createEndpointConfig_asyncInferenceConfig,
    createEndpointConfig_dataCaptureConfig,
    createEndpointConfig_explainerConfig,
    createEndpointConfig_kmsKeyId,
    createEndpointConfig_shadowProductionVariants,
    createEndpointConfig_tags,
    createEndpointConfig_endpointConfigName,
    createEndpointConfig_productionVariants,

    -- * Destructuring the Response
    CreateEndpointConfigResponse (..),
    newCreateEndpointConfigResponse,

    -- * Response Lenses
    createEndpointConfigResponse_httpStatus,
    createEndpointConfigResponse_endpointConfigArn,
  )
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:/ 'newCreateEndpointConfig' smart constructor.
data CreateEndpointConfig = CreateEndpointConfig'
  { -- | Specifies configuration for how an endpoint performs asynchronous
    -- inference. This is a required field in order for your Endpoint to be
    -- invoked using
    -- <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_runtime_InvokeEndpointAsync.html InvokeEndpointAsync>.
    CreateEndpointConfig -> Maybe AsyncInferenceConfig
asyncInferenceConfig :: Prelude.Maybe AsyncInferenceConfig,
    CreateEndpointConfig -> Maybe DataCaptureConfig
dataCaptureConfig :: Prelude.Maybe DataCaptureConfig,
    -- | A member of @CreateEndpointConfig@ that enables explainers.
    CreateEndpointConfig -> Maybe ExplainerConfig
explainerConfig :: Prelude.Maybe ExplainerConfig,
    -- | The Amazon Resource Name (ARN) of a Amazon Web Services Key Management
    -- Service key that SageMaker uses to encrypt data on the storage volume
    -- attached to the ML compute instance that hosts the endpoint.
    --
    -- The KmsKeyId can be any of the following formats:
    --
    -- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Key ARN:
    --     @arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
    --
    -- -   Alias name: @alias\/ExampleAlias@
    --
    -- -   Alias name ARN:
    --     @arn:aws:kms:us-west-2:111122223333:alias\/ExampleAlias@
    --
    -- The KMS key policy must grant permission to the IAM role that you
    -- specify in your @CreateEndpoint@, @UpdateEndpoint@ requests. For more
    -- information, refer to the Amazon Web Services Key Management Service
    -- section
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/key-policies.html Using Key Policies in Amazon Web Services KMS>
    --
    -- Certain Nitro-based instances include local storage, dependent on the
    -- instance type. Local storage volumes are encrypted using a hardware
    -- module on the instance. You can\'t request a @KmsKeyId@ when using an
    -- instance type with local storage. If any of the models that you specify
    -- in the @ProductionVariants@ parameter use nitro-based instances with
    -- local storage, do not specify a value for the @KmsKeyId@ parameter. If
    -- you specify a value for @KmsKeyId@ when using any nitro-based instances
    -- with local storage, the call to @CreateEndpointConfig@ fails.
    --
    -- For a list of instance types that support local instance storage, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/InstanceStorage.html#instance-store-volumes Instance Store Volumes>.
    --
    -- For more information about local instance storage encryption, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ssd-instance-store.html SSD Instance Store Volumes>.
    CreateEndpointConfig -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | An array of @ProductionVariant@ objects, one for each model that you
    -- want to host at this endpoint in shadow mode with production traffic
    -- replicated from the model specified on @ProductionVariants@. If you use
    -- this field, you can only specify one variant for @ProductionVariants@
    -- and one variant for @ShadowProductionVariants@.
    CreateEndpointConfig -> Maybe (NonEmpty ProductionVariant)
shadowProductionVariants :: Prelude.Maybe (Prelude.NonEmpty ProductionVariant),
    -- | An 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/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
    CreateEndpointConfig -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the endpoint configuration. You specify this name in a
    -- CreateEndpoint request.
    CreateEndpointConfig -> Text
endpointConfigName :: Prelude.Text,
    -- | An array of @ProductionVariant@ objects, one for each model that you
    -- want to host at this endpoint.
    CreateEndpointConfig -> NonEmpty ProductionVariant
productionVariants :: Prelude.NonEmpty ProductionVariant
  }
  deriving (CreateEndpointConfig -> CreateEndpointConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEndpointConfig -> CreateEndpointConfig -> Bool
$c/= :: CreateEndpointConfig -> CreateEndpointConfig -> Bool
== :: CreateEndpointConfig -> CreateEndpointConfig -> Bool
$c== :: CreateEndpointConfig -> CreateEndpointConfig -> Bool
Prelude.Eq, ReadPrec [CreateEndpointConfig]
ReadPrec CreateEndpointConfig
Int -> ReadS CreateEndpointConfig
ReadS [CreateEndpointConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEndpointConfig]
$creadListPrec :: ReadPrec [CreateEndpointConfig]
readPrec :: ReadPrec CreateEndpointConfig
$creadPrec :: ReadPrec CreateEndpointConfig
readList :: ReadS [CreateEndpointConfig]
$creadList :: ReadS [CreateEndpointConfig]
readsPrec :: Int -> ReadS CreateEndpointConfig
$creadsPrec :: Int -> ReadS CreateEndpointConfig
Prelude.Read, Int -> CreateEndpointConfig -> ShowS
[CreateEndpointConfig] -> ShowS
CreateEndpointConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEndpointConfig] -> ShowS
$cshowList :: [CreateEndpointConfig] -> ShowS
show :: CreateEndpointConfig -> String
$cshow :: CreateEndpointConfig -> String
showsPrec :: Int -> CreateEndpointConfig -> ShowS
$cshowsPrec :: Int -> CreateEndpointConfig -> ShowS
Prelude.Show, forall x. Rep CreateEndpointConfig x -> CreateEndpointConfig
forall x. CreateEndpointConfig -> Rep CreateEndpointConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEndpointConfig x -> CreateEndpointConfig
$cfrom :: forall x. CreateEndpointConfig -> Rep CreateEndpointConfig x
Prelude.Generic)

-- |
-- Create a value of 'CreateEndpointConfig' 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:
--
-- 'asyncInferenceConfig', 'createEndpointConfig_asyncInferenceConfig' - Specifies configuration for how an endpoint performs asynchronous
-- inference. This is a required field in order for your Endpoint to be
-- invoked using
-- <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_runtime_InvokeEndpointAsync.html InvokeEndpointAsync>.
--
-- 'dataCaptureConfig', 'createEndpointConfig_dataCaptureConfig' - Undocumented member.
--
-- 'explainerConfig', 'createEndpointConfig_explainerConfig' - A member of @CreateEndpointConfig@ that enables explainers.
--
-- 'kmsKeyId', 'createEndpointConfig_kmsKeyId' - The Amazon Resource Name (ARN) of a Amazon Web Services Key Management
-- Service key that SageMaker uses to encrypt data on the storage volume
-- attached to the ML compute instance that hosts the endpoint.
--
-- The KmsKeyId can be any of the following formats:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias name ARN:
--     @arn:aws:kms:us-west-2:111122223333:alias\/ExampleAlias@
--
-- The KMS key policy must grant permission to the IAM role that you
-- specify in your @CreateEndpoint@, @UpdateEndpoint@ requests. For more
-- information, refer to the Amazon Web Services Key Management Service
-- section
-- <https://docs.aws.amazon.com/kms/latest/developerguide/key-policies.html Using Key Policies in Amazon Web Services KMS>
--
-- Certain Nitro-based instances include local storage, dependent on the
-- instance type. Local storage volumes are encrypted using a hardware
-- module on the instance. You can\'t request a @KmsKeyId@ when using an
-- instance type with local storage. If any of the models that you specify
-- in the @ProductionVariants@ parameter use nitro-based instances with
-- local storage, do not specify a value for the @KmsKeyId@ parameter. If
-- you specify a value for @KmsKeyId@ when using any nitro-based instances
-- with local storage, the call to @CreateEndpointConfig@ fails.
--
-- For a list of instance types that support local instance storage, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/InstanceStorage.html#instance-store-volumes Instance Store Volumes>.
--
-- For more information about local instance storage encryption, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ssd-instance-store.html SSD Instance Store Volumes>.
--
-- 'shadowProductionVariants', 'createEndpointConfig_shadowProductionVariants' - An array of @ProductionVariant@ objects, one for each model that you
-- want to host at this endpoint in shadow mode with production traffic
-- replicated from the model specified on @ProductionVariants@. If you use
-- this field, you can only specify one variant for @ProductionVariants@
-- and one variant for @ShadowProductionVariants@.
--
-- 'tags', 'createEndpointConfig_tags' - An 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/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
--
-- 'endpointConfigName', 'createEndpointConfig_endpointConfigName' - The name of the endpoint configuration. You specify this name in a
-- CreateEndpoint request.
--
-- 'productionVariants', 'createEndpointConfig_productionVariants' - An array of @ProductionVariant@ objects, one for each model that you
-- want to host at this endpoint.
newCreateEndpointConfig ::
  -- | 'endpointConfigName'
  Prelude.Text ->
  -- | 'productionVariants'
  Prelude.NonEmpty ProductionVariant ->
  CreateEndpointConfig
newCreateEndpointConfig :: Text -> NonEmpty ProductionVariant -> CreateEndpointConfig
newCreateEndpointConfig
  Text
pEndpointConfigName_
  NonEmpty ProductionVariant
pProductionVariants_ =
    CreateEndpointConfig'
      { $sel:asyncInferenceConfig:CreateEndpointConfig' :: Maybe AsyncInferenceConfig
asyncInferenceConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dataCaptureConfig:CreateEndpointConfig' :: Maybe DataCaptureConfig
dataCaptureConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:explainerConfig:CreateEndpointConfig' :: Maybe ExplainerConfig
explainerConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CreateEndpointConfig' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:shadowProductionVariants:CreateEndpointConfig' :: Maybe (NonEmpty ProductionVariant)
shadowProductionVariants = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateEndpointConfig' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:endpointConfigName:CreateEndpointConfig' :: Text
endpointConfigName = Text
pEndpointConfigName_,
        $sel:productionVariants:CreateEndpointConfig' :: NonEmpty ProductionVariant
productionVariants =
          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 ProductionVariant
pProductionVariants_
      }

-- | Specifies configuration for how an endpoint performs asynchronous
-- inference. This is a required field in order for your Endpoint to be
-- invoked using
-- <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_runtime_InvokeEndpointAsync.html InvokeEndpointAsync>.
createEndpointConfig_asyncInferenceConfig :: Lens.Lens' CreateEndpointConfig (Prelude.Maybe AsyncInferenceConfig)
createEndpointConfig_asyncInferenceConfig :: Lens' CreateEndpointConfig (Maybe AsyncInferenceConfig)
createEndpointConfig_asyncInferenceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {Maybe AsyncInferenceConfig
asyncInferenceConfig :: Maybe AsyncInferenceConfig
$sel:asyncInferenceConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe AsyncInferenceConfig
asyncInferenceConfig} -> Maybe AsyncInferenceConfig
asyncInferenceConfig) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} Maybe AsyncInferenceConfig
a -> CreateEndpointConfig
s {$sel:asyncInferenceConfig:CreateEndpointConfig' :: Maybe AsyncInferenceConfig
asyncInferenceConfig = Maybe AsyncInferenceConfig
a} :: CreateEndpointConfig)

-- | Undocumented member.
createEndpointConfig_dataCaptureConfig :: Lens.Lens' CreateEndpointConfig (Prelude.Maybe DataCaptureConfig)
createEndpointConfig_dataCaptureConfig :: Lens' CreateEndpointConfig (Maybe DataCaptureConfig)
createEndpointConfig_dataCaptureConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {Maybe DataCaptureConfig
dataCaptureConfig :: Maybe DataCaptureConfig
$sel:dataCaptureConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe DataCaptureConfig
dataCaptureConfig} -> Maybe DataCaptureConfig
dataCaptureConfig) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} Maybe DataCaptureConfig
a -> CreateEndpointConfig
s {$sel:dataCaptureConfig:CreateEndpointConfig' :: Maybe DataCaptureConfig
dataCaptureConfig = Maybe DataCaptureConfig
a} :: CreateEndpointConfig)

-- | A member of @CreateEndpointConfig@ that enables explainers.
createEndpointConfig_explainerConfig :: Lens.Lens' CreateEndpointConfig (Prelude.Maybe ExplainerConfig)
createEndpointConfig_explainerConfig :: Lens' CreateEndpointConfig (Maybe ExplainerConfig)
createEndpointConfig_explainerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {Maybe ExplainerConfig
explainerConfig :: Maybe ExplainerConfig
$sel:explainerConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe ExplainerConfig
explainerConfig} -> Maybe ExplainerConfig
explainerConfig) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} Maybe ExplainerConfig
a -> CreateEndpointConfig
s {$sel:explainerConfig:CreateEndpointConfig' :: Maybe ExplainerConfig
explainerConfig = Maybe ExplainerConfig
a} :: CreateEndpointConfig)

-- | The Amazon Resource Name (ARN) of a Amazon Web Services Key Management
-- Service key that SageMaker uses to encrypt data on the storage volume
-- attached to the ML compute instance that hosts the endpoint.
--
-- The KmsKeyId can be any of the following formats:
--
-- -   Key ID: @1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Key ARN:
--     @arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@
--
-- -   Alias name: @alias\/ExampleAlias@
--
-- -   Alias name ARN:
--     @arn:aws:kms:us-west-2:111122223333:alias\/ExampleAlias@
--
-- The KMS key policy must grant permission to the IAM role that you
-- specify in your @CreateEndpoint@, @UpdateEndpoint@ requests. For more
-- information, refer to the Amazon Web Services Key Management Service
-- section
-- <https://docs.aws.amazon.com/kms/latest/developerguide/key-policies.html Using Key Policies in Amazon Web Services KMS>
--
-- Certain Nitro-based instances include local storage, dependent on the
-- instance type. Local storage volumes are encrypted using a hardware
-- module on the instance. You can\'t request a @KmsKeyId@ when using an
-- instance type with local storage. If any of the models that you specify
-- in the @ProductionVariants@ parameter use nitro-based instances with
-- local storage, do not specify a value for the @KmsKeyId@ parameter. If
-- you specify a value for @KmsKeyId@ when using any nitro-based instances
-- with local storage, the call to @CreateEndpointConfig@ fails.
--
-- For a list of instance types that support local instance storage, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/InstanceStorage.html#instance-store-volumes Instance Store Volumes>.
--
-- For more information about local instance storage encryption, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ssd-instance-store.html SSD Instance Store Volumes>.
createEndpointConfig_kmsKeyId :: Lens.Lens' CreateEndpointConfig (Prelude.Maybe Prelude.Text)
createEndpointConfig_kmsKeyId :: Lens' CreateEndpointConfig (Maybe Text)
createEndpointConfig_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} Maybe Text
a -> CreateEndpointConfig
s {$sel:kmsKeyId:CreateEndpointConfig' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateEndpointConfig)

-- | An array of @ProductionVariant@ objects, one for each model that you
-- want to host at this endpoint in shadow mode with production traffic
-- replicated from the model specified on @ProductionVariants@. If you use
-- this field, you can only specify one variant for @ProductionVariants@
-- and one variant for @ShadowProductionVariants@.
createEndpointConfig_shadowProductionVariants :: Lens.Lens' CreateEndpointConfig (Prelude.Maybe (Prelude.NonEmpty ProductionVariant))
createEndpointConfig_shadowProductionVariants :: Lens' CreateEndpointConfig (Maybe (NonEmpty ProductionVariant))
createEndpointConfig_shadowProductionVariants = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {Maybe (NonEmpty ProductionVariant)
shadowProductionVariants :: Maybe (NonEmpty ProductionVariant)
$sel:shadowProductionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe (NonEmpty ProductionVariant)
shadowProductionVariants} -> Maybe (NonEmpty ProductionVariant)
shadowProductionVariants) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} Maybe (NonEmpty ProductionVariant)
a -> CreateEndpointConfig
s {$sel:shadowProductionVariants:CreateEndpointConfig' :: Maybe (NonEmpty ProductionVariant)
shadowProductionVariants = Maybe (NonEmpty ProductionVariant)
a} :: CreateEndpointConfig) 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

-- | An 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/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
createEndpointConfig_tags :: Lens.Lens' CreateEndpointConfig (Prelude.Maybe [Tag])
createEndpointConfig_tags :: Lens' CreateEndpointConfig (Maybe [Tag])
createEndpointConfig_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} Maybe [Tag]
a -> CreateEndpointConfig
s {$sel:tags:CreateEndpointConfig' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateEndpointConfig) 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 of the endpoint configuration. You specify this name in a
-- CreateEndpoint request.
createEndpointConfig_endpointConfigName :: Lens.Lens' CreateEndpointConfig Prelude.Text
createEndpointConfig_endpointConfigName :: Lens' CreateEndpointConfig Text
createEndpointConfig_endpointConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {Text
endpointConfigName :: Text
$sel:endpointConfigName:CreateEndpointConfig' :: CreateEndpointConfig -> Text
endpointConfigName} -> Text
endpointConfigName) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} Text
a -> CreateEndpointConfig
s {$sel:endpointConfigName:CreateEndpointConfig' :: Text
endpointConfigName = Text
a} :: CreateEndpointConfig)

-- | An array of @ProductionVariant@ objects, one for each model that you
-- want to host at this endpoint.
createEndpointConfig_productionVariants :: Lens.Lens' CreateEndpointConfig (Prelude.NonEmpty ProductionVariant)
createEndpointConfig_productionVariants :: Lens' CreateEndpointConfig (NonEmpty ProductionVariant)
createEndpointConfig_productionVariants = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfig' {NonEmpty ProductionVariant
productionVariants :: NonEmpty ProductionVariant
$sel:productionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> NonEmpty ProductionVariant
productionVariants} -> NonEmpty ProductionVariant
productionVariants) (\s :: CreateEndpointConfig
s@CreateEndpointConfig' {} NonEmpty ProductionVariant
a -> CreateEndpointConfig
s {$sel:productionVariants:CreateEndpointConfig' :: NonEmpty ProductionVariant
productionVariants = NonEmpty ProductionVariant
a} :: CreateEndpointConfig) 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

instance Core.AWSRequest CreateEndpointConfig where
  type
    AWSResponse CreateEndpointConfig =
      CreateEndpointConfigResponse
  request :: (Service -> Service)
-> CreateEndpointConfig -> Request CreateEndpointConfig
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 CreateEndpointConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateEndpointConfig)))
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 -> CreateEndpointConfigResponse
CreateEndpointConfigResponse'
            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
"EndpointConfigArn")
      )

instance Prelude.Hashable CreateEndpointConfig where
  hashWithSalt :: Int -> CreateEndpointConfig -> Int
hashWithSalt Int
_salt CreateEndpointConfig' {Maybe [Tag]
Maybe (NonEmpty ProductionVariant)
Maybe Text
Maybe AsyncInferenceConfig
Maybe DataCaptureConfig
Maybe ExplainerConfig
NonEmpty ProductionVariant
Text
productionVariants :: NonEmpty ProductionVariant
endpointConfigName :: Text
tags :: Maybe [Tag]
shadowProductionVariants :: Maybe (NonEmpty ProductionVariant)
kmsKeyId :: Maybe Text
explainerConfig :: Maybe ExplainerConfig
dataCaptureConfig :: Maybe DataCaptureConfig
asyncInferenceConfig :: Maybe AsyncInferenceConfig
$sel:productionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> NonEmpty ProductionVariant
$sel:endpointConfigName:CreateEndpointConfig' :: CreateEndpointConfig -> Text
$sel:tags:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe [Tag]
$sel:shadowProductionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe (NonEmpty ProductionVariant)
$sel:kmsKeyId:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe Text
$sel:explainerConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe ExplainerConfig
$sel:dataCaptureConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe DataCaptureConfig
$sel:asyncInferenceConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe AsyncInferenceConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AsyncInferenceConfig
asyncInferenceConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataCaptureConfig
dataCaptureConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExplainerConfig
explainerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ProductionVariant)
shadowProductionVariants
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointConfigName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ProductionVariant
productionVariants

instance Prelude.NFData CreateEndpointConfig where
  rnf :: CreateEndpointConfig -> ()
rnf CreateEndpointConfig' {Maybe [Tag]
Maybe (NonEmpty ProductionVariant)
Maybe Text
Maybe AsyncInferenceConfig
Maybe DataCaptureConfig
Maybe ExplainerConfig
NonEmpty ProductionVariant
Text
productionVariants :: NonEmpty ProductionVariant
endpointConfigName :: Text
tags :: Maybe [Tag]
shadowProductionVariants :: Maybe (NonEmpty ProductionVariant)
kmsKeyId :: Maybe Text
explainerConfig :: Maybe ExplainerConfig
dataCaptureConfig :: Maybe DataCaptureConfig
asyncInferenceConfig :: Maybe AsyncInferenceConfig
$sel:productionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> NonEmpty ProductionVariant
$sel:endpointConfigName:CreateEndpointConfig' :: CreateEndpointConfig -> Text
$sel:tags:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe [Tag]
$sel:shadowProductionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe (NonEmpty ProductionVariant)
$sel:kmsKeyId:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe Text
$sel:explainerConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe ExplainerConfig
$sel:dataCaptureConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe DataCaptureConfig
$sel:asyncInferenceConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe AsyncInferenceConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AsyncInferenceConfig
asyncInferenceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataCaptureConfig
dataCaptureConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExplainerConfig
explainerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ProductionVariant)
shadowProductionVariants
      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
endpointConfigName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ProductionVariant
productionVariants

instance Data.ToHeaders CreateEndpointConfig where
  toHeaders :: CreateEndpointConfig -> 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.CreateEndpointConfig" ::
                          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 CreateEndpointConfig where
  toJSON :: CreateEndpointConfig -> Value
toJSON CreateEndpointConfig' {Maybe [Tag]
Maybe (NonEmpty ProductionVariant)
Maybe Text
Maybe AsyncInferenceConfig
Maybe DataCaptureConfig
Maybe ExplainerConfig
NonEmpty ProductionVariant
Text
productionVariants :: NonEmpty ProductionVariant
endpointConfigName :: Text
tags :: Maybe [Tag]
shadowProductionVariants :: Maybe (NonEmpty ProductionVariant)
kmsKeyId :: Maybe Text
explainerConfig :: Maybe ExplainerConfig
dataCaptureConfig :: Maybe DataCaptureConfig
asyncInferenceConfig :: Maybe AsyncInferenceConfig
$sel:productionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> NonEmpty ProductionVariant
$sel:endpointConfigName:CreateEndpointConfig' :: CreateEndpointConfig -> Text
$sel:tags:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe [Tag]
$sel:shadowProductionVariants:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe (NonEmpty ProductionVariant)
$sel:kmsKeyId:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe Text
$sel:explainerConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe ExplainerConfig
$sel:dataCaptureConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe DataCaptureConfig
$sel:asyncInferenceConfig:CreateEndpointConfig' :: CreateEndpointConfig -> Maybe AsyncInferenceConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AsyncInferenceConfig" 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 AsyncInferenceConfig
asyncInferenceConfig,
            (Key
"DataCaptureConfig" 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 DataCaptureConfig
dataCaptureConfig,
            (Key
"ExplainerConfig" 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 ExplainerConfig
explainerConfig,
            (Key
"KmsKeyId" 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
kmsKeyId,
            (Key
"ShadowProductionVariants" 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 (NonEmpty ProductionVariant)
shadowProductionVariants,
            (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
"EndpointConfigName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointConfigName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ProductionVariants" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ProductionVariant
productionVariants)
          ]
      )

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

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

-- | /See:/ 'newCreateEndpointConfigResponse' smart constructor.
data CreateEndpointConfigResponse = CreateEndpointConfigResponse'
  { -- | The response's http status code.
    CreateEndpointConfigResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the endpoint configuration.
    CreateEndpointConfigResponse -> Text
endpointConfigArn :: Prelude.Text
  }
  deriving (CreateEndpointConfigResponse
-> CreateEndpointConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEndpointConfigResponse
-> CreateEndpointConfigResponse -> Bool
$c/= :: CreateEndpointConfigResponse
-> CreateEndpointConfigResponse -> Bool
== :: CreateEndpointConfigResponse
-> CreateEndpointConfigResponse -> Bool
$c== :: CreateEndpointConfigResponse
-> CreateEndpointConfigResponse -> Bool
Prelude.Eq, ReadPrec [CreateEndpointConfigResponse]
ReadPrec CreateEndpointConfigResponse
Int -> ReadS CreateEndpointConfigResponse
ReadS [CreateEndpointConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEndpointConfigResponse]
$creadListPrec :: ReadPrec [CreateEndpointConfigResponse]
readPrec :: ReadPrec CreateEndpointConfigResponse
$creadPrec :: ReadPrec CreateEndpointConfigResponse
readList :: ReadS [CreateEndpointConfigResponse]
$creadList :: ReadS [CreateEndpointConfigResponse]
readsPrec :: Int -> ReadS CreateEndpointConfigResponse
$creadsPrec :: Int -> ReadS CreateEndpointConfigResponse
Prelude.Read, Int -> CreateEndpointConfigResponse -> ShowS
[CreateEndpointConfigResponse] -> ShowS
CreateEndpointConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEndpointConfigResponse] -> ShowS
$cshowList :: [CreateEndpointConfigResponse] -> ShowS
show :: CreateEndpointConfigResponse -> String
$cshow :: CreateEndpointConfigResponse -> String
showsPrec :: Int -> CreateEndpointConfigResponse -> ShowS
$cshowsPrec :: Int -> CreateEndpointConfigResponse -> ShowS
Prelude.Show, forall x.
Rep CreateEndpointConfigResponse x -> CreateEndpointConfigResponse
forall x.
CreateEndpointConfigResponse -> Rep CreateEndpointConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateEndpointConfigResponse x -> CreateEndpointConfigResponse
$cfrom :: forall x.
CreateEndpointConfigResponse -> Rep CreateEndpointConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateEndpointConfigResponse' 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', 'createEndpointConfigResponse_httpStatus' - The response's http status code.
--
-- 'endpointConfigArn', 'createEndpointConfigResponse_endpointConfigArn' - The Amazon Resource Name (ARN) of the endpoint configuration.
newCreateEndpointConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'endpointConfigArn'
  Prelude.Text ->
  CreateEndpointConfigResponse
newCreateEndpointConfigResponse :: Int -> Text -> CreateEndpointConfigResponse
newCreateEndpointConfigResponse
  Int
pHttpStatus_
  Text
pEndpointConfigArn_ =
    CreateEndpointConfigResponse'
      { $sel:httpStatus:CreateEndpointConfigResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:endpointConfigArn:CreateEndpointConfigResponse' :: Text
endpointConfigArn = Text
pEndpointConfigArn_
      }

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

-- | The Amazon Resource Name (ARN) of the endpoint configuration.
createEndpointConfigResponse_endpointConfigArn :: Lens.Lens' CreateEndpointConfigResponse Prelude.Text
createEndpointConfigResponse_endpointConfigArn :: Lens' CreateEndpointConfigResponse Text
createEndpointConfigResponse_endpointConfigArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointConfigResponse' {Text
endpointConfigArn :: Text
$sel:endpointConfigArn:CreateEndpointConfigResponse' :: CreateEndpointConfigResponse -> Text
endpointConfigArn} -> Text
endpointConfigArn) (\s :: CreateEndpointConfigResponse
s@CreateEndpointConfigResponse' {} Text
a -> CreateEndpointConfigResponse
s {$sel:endpointConfigArn:CreateEndpointConfigResponse' :: Text
endpointConfigArn = Text
a} :: CreateEndpointConfigResponse)

instance Prelude.NFData CreateEndpointConfigResponse where
  rnf :: CreateEndpointConfigResponse -> ()
rnf CreateEndpointConfigResponse' {Int
Text
endpointConfigArn :: Text
httpStatus :: Int
$sel:endpointConfigArn:CreateEndpointConfigResponse' :: CreateEndpointConfigResponse -> Text
$sel:httpStatus:CreateEndpointConfigResponse' :: CreateEndpointConfigResponse -> 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
endpointConfigArn