{-# 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.UpdateEndpoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deploys the new @EndpointConfig@ specified in the request, switches to
-- using newly created endpoint, and then deletes resources provisioned for
-- the endpoint using the previous @EndpointConfig@ (there is no
-- availability loss).
--
-- When SageMaker receives the request, it sets the endpoint status to
-- @Updating@. After updating the endpoint, it sets the status to
-- @InService@. To check the status of an endpoint, use the
-- DescribeEndpoint API.
--
-- You must not delete an @EndpointConfig@ in use by an endpoint that is
-- live or while the @UpdateEndpoint@ or @CreateEndpoint@ operations are
-- being performed on the endpoint. To update an endpoint, you must create
-- a new @EndpointConfig@.
--
-- If you delete the @EndpointConfig@ of an endpoint that is active or
-- being created or updated you may lose visibility into the instance type
-- the endpoint is using. The endpoint must be deleted in order to stop
-- incurring charges.
module Amazonka.SageMaker.UpdateEndpoint
  ( -- * Creating a Request
    UpdateEndpoint (..),
    newUpdateEndpoint,

    -- * Request Lenses
    updateEndpoint_deploymentConfig,
    updateEndpoint_excludeRetainedVariantProperties,
    updateEndpoint_retainAllVariantProperties,
    updateEndpoint_retainDeploymentConfig,
    updateEndpoint_endpointName,
    updateEndpoint_endpointConfigName,

    -- * Destructuring the Response
    UpdateEndpointResponse (..),
    newUpdateEndpointResponse,

    -- * Response Lenses
    updateEndpointResponse_httpStatus,
    updateEndpointResponse_endpointArn,
  )
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:/ 'newUpdateEndpoint' smart constructor.
data UpdateEndpoint = UpdateEndpoint'
  { -- | The deployment configuration for an endpoint, which contains the desired
    -- deployment strategy and rollback configurations.
    UpdateEndpoint -> Maybe DeploymentConfig
deploymentConfig :: Prelude.Maybe DeploymentConfig,
    -- | When you are updating endpoint resources with
    -- UpdateEndpointInput$RetainAllVariantProperties, whose value is set to
    -- @true@, @ExcludeRetainedVariantProperties@ specifies the list of type
    -- VariantProperty to override with the values provided by
    -- @EndpointConfig@. If you don\'t specify a value for
    -- @ExcludeAllVariantProperties@, no variant properties are overridden.
    UpdateEndpoint -> Maybe [VariantProperty]
excludeRetainedVariantProperties :: Prelude.Maybe [VariantProperty],
    -- | When updating endpoint resources, enables or disables the retention of
    -- <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_VariantProperty.html variant properties>,
    -- such as the instance count or the variant weight. To retain the variant
    -- properties of an endpoint when updating it, set
    -- @RetainAllVariantProperties@ to @true@. To use the variant properties
    -- specified in a new @EndpointConfig@ call when updating an endpoint, set
    -- @RetainAllVariantProperties@ to @false@. The default is @false@.
    UpdateEndpoint -> Maybe Bool
retainAllVariantProperties :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether to reuse the last deployment configuration. The
    -- default value is false (the configuration is not reused).
    UpdateEndpoint -> Maybe Bool
retainDeploymentConfig :: Prelude.Maybe Prelude.Bool,
    -- | The name of the endpoint whose configuration you want to update.
    UpdateEndpoint -> Text
endpointName :: Prelude.Text,
    -- | The name of the new endpoint configuration.
    UpdateEndpoint -> Text
endpointConfigName :: Prelude.Text
  }
  deriving (UpdateEndpoint -> UpdateEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEndpoint -> UpdateEndpoint -> Bool
$c/= :: UpdateEndpoint -> UpdateEndpoint -> Bool
== :: UpdateEndpoint -> UpdateEndpoint -> Bool
$c== :: UpdateEndpoint -> UpdateEndpoint -> Bool
Prelude.Eq, ReadPrec [UpdateEndpoint]
ReadPrec UpdateEndpoint
Int -> ReadS UpdateEndpoint
ReadS [UpdateEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEndpoint]
$creadListPrec :: ReadPrec [UpdateEndpoint]
readPrec :: ReadPrec UpdateEndpoint
$creadPrec :: ReadPrec UpdateEndpoint
readList :: ReadS [UpdateEndpoint]
$creadList :: ReadS [UpdateEndpoint]
readsPrec :: Int -> ReadS UpdateEndpoint
$creadsPrec :: Int -> ReadS UpdateEndpoint
Prelude.Read, Int -> UpdateEndpoint -> ShowS
[UpdateEndpoint] -> ShowS
UpdateEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEndpoint] -> ShowS
$cshowList :: [UpdateEndpoint] -> ShowS
show :: UpdateEndpoint -> String
$cshow :: UpdateEndpoint -> String
showsPrec :: Int -> UpdateEndpoint -> ShowS
$cshowsPrec :: Int -> UpdateEndpoint -> ShowS
Prelude.Show, forall x. Rep UpdateEndpoint x -> UpdateEndpoint
forall x. UpdateEndpoint -> Rep UpdateEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateEndpoint x -> UpdateEndpoint
$cfrom :: forall x. UpdateEndpoint -> Rep UpdateEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEndpoint' 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:
--
-- 'deploymentConfig', 'updateEndpoint_deploymentConfig' - The deployment configuration for an endpoint, which contains the desired
-- deployment strategy and rollback configurations.
--
-- 'excludeRetainedVariantProperties', 'updateEndpoint_excludeRetainedVariantProperties' - When you are updating endpoint resources with
-- UpdateEndpointInput$RetainAllVariantProperties, whose value is set to
-- @true@, @ExcludeRetainedVariantProperties@ specifies the list of type
-- VariantProperty to override with the values provided by
-- @EndpointConfig@. If you don\'t specify a value for
-- @ExcludeAllVariantProperties@, no variant properties are overridden.
--
-- 'retainAllVariantProperties', 'updateEndpoint_retainAllVariantProperties' - When updating endpoint resources, enables or disables the retention of
-- <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_VariantProperty.html variant properties>,
-- such as the instance count or the variant weight. To retain the variant
-- properties of an endpoint when updating it, set
-- @RetainAllVariantProperties@ to @true@. To use the variant properties
-- specified in a new @EndpointConfig@ call when updating an endpoint, set
-- @RetainAllVariantProperties@ to @false@. The default is @false@.
--
-- 'retainDeploymentConfig', 'updateEndpoint_retainDeploymentConfig' - Specifies whether to reuse the last deployment configuration. The
-- default value is false (the configuration is not reused).
--
-- 'endpointName', 'updateEndpoint_endpointName' - The name of the endpoint whose configuration you want to update.
--
-- 'endpointConfigName', 'updateEndpoint_endpointConfigName' - The name of the new endpoint configuration.
newUpdateEndpoint ::
  -- | 'endpointName'
  Prelude.Text ->
  -- | 'endpointConfigName'
  Prelude.Text ->
  UpdateEndpoint
newUpdateEndpoint :: Text -> Text -> UpdateEndpoint
newUpdateEndpoint Text
pEndpointName_ Text
pEndpointConfigName_ =
  UpdateEndpoint'
    { $sel:deploymentConfig:UpdateEndpoint' :: Maybe DeploymentConfig
deploymentConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:excludeRetainedVariantProperties:UpdateEndpoint' :: Maybe [VariantProperty]
excludeRetainedVariantProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:retainAllVariantProperties:UpdateEndpoint' :: Maybe Bool
retainAllVariantProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:retainDeploymentConfig:UpdateEndpoint' :: Maybe Bool
retainDeploymentConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointName:UpdateEndpoint' :: Text
endpointName = Text
pEndpointName_,
      $sel:endpointConfigName:UpdateEndpoint' :: Text
endpointConfigName = Text
pEndpointConfigName_
    }

-- | The deployment configuration for an endpoint, which contains the desired
-- deployment strategy and rollback configurations.
updateEndpoint_deploymentConfig :: Lens.Lens' UpdateEndpoint (Prelude.Maybe DeploymentConfig)
updateEndpoint_deploymentConfig :: Lens' UpdateEndpoint (Maybe DeploymentConfig)
updateEndpoint_deploymentConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEndpoint' {Maybe DeploymentConfig
deploymentConfig :: Maybe DeploymentConfig
$sel:deploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe DeploymentConfig
deploymentConfig} -> Maybe DeploymentConfig
deploymentConfig) (\s :: UpdateEndpoint
s@UpdateEndpoint' {} Maybe DeploymentConfig
a -> UpdateEndpoint
s {$sel:deploymentConfig:UpdateEndpoint' :: Maybe DeploymentConfig
deploymentConfig = Maybe DeploymentConfig
a} :: UpdateEndpoint)

-- | When you are updating endpoint resources with
-- UpdateEndpointInput$RetainAllVariantProperties, whose value is set to
-- @true@, @ExcludeRetainedVariantProperties@ specifies the list of type
-- VariantProperty to override with the values provided by
-- @EndpointConfig@. If you don\'t specify a value for
-- @ExcludeAllVariantProperties@, no variant properties are overridden.
updateEndpoint_excludeRetainedVariantProperties :: Lens.Lens' UpdateEndpoint (Prelude.Maybe [VariantProperty])
updateEndpoint_excludeRetainedVariantProperties :: Lens' UpdateEndpoint (Maybe [VariantProperty])
updateEndpoint_excludeRetainedVariantProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEndpoint' {Maybe [VariantProperty]
excludeRetainedVariantProperties :: Maybe [VariantProperty]
$sel:excludeRetainedVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe [VariantProperty]
excludeRetainedVariantProperties} -> Maybe [VariantProperty]
excludeRetainedVariantProperties) (\s :: UpdateEndpoint
s@UpdateEndpoint' {} Maybe [VariantProperty]
a -> UpdateEndpoint
s {$sel:excludeRetainedVariantProperties:UpdateEndpoint' :: Maybe [VariantProperty]
excludeRetainedVariantProperties = Maybe [VariantProperty]
a} :: UpdateEndpoint) 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

-- | When updating endpoint resources, enables or disables the retention of
-- <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_VariantProperty.html variant properties>,
-- such as the instance count or the variant weight. To retain the variant
-- properties of an endpoint when updating it, set
-- @RetainAllVariantProperties@ to @true@. To use the variant properties
-- specified in a new @EndpointConfig@ call when updating an endpoint, set
-- @RetainAllVariantProperties@ to @false@. The default is @false@.
updateEndpoint_retainAllVariantProperties :: Lens.Lens' UpdateEndpoint (Prelude.Maybe Prelude.Bool)
updateEndpoint_retainAllVariantProperties :: Lens' UpdateEndpoint (Maybe Bool)
updateEndpoint_retainAllVariantProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEndpoint' {Maybe Bool
retainAllVariantProperties :: Maybe Bool
$sel:retainAllVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
retainAllVariantProperties} -> Maybe Bool
retainAllVariantProperties) (\s :: UpdateEndpoint
s@UpdateEndpoint' {} Maybe Bool
a -> UpdateEndpoint
s {$sel:retainAllVariantProperties:UpdateEndpoint' :: Maybe Bool
retainAllVariantProperties = Maybe Bool
a} :: UpdateEndpoint)

-- | Specifies whether to reuse the last deployment configuration. The
-- default value is false (the configuration is not reused).
updateEndpoint_retainDeploymentConfig :: Lens.Lens' UpdateEndpoint (Prelude.Maybe Prelude.Bool)
updateEndpoint_retainDeploymentConfig :: Lens' UpdateEndpoint (Maybe Bool)
updateEndpoint_retainDeploymentConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEndpoint' {Maybe Bool
retainDeploymentConfig :: Maybe Bool
$sel:retainDeploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
retainDeploymentConfig} -> Maybe Bool
retainDeploymentConfig) (\s :: UpdateEndpoint
s@UpdateEndpoint' {} Maybe Bool
a -> UpdateEndpoint
s {$sel:retainDeploymentConfig:UpdateEndpoint' :: Maybe Bool
retainDeploymentConfig = Maybe Bool
a} :: UpdateEndpoint)

-- | The name of the endpoint whose configuration you want to update.
updateEndpoint_endpointName :: Lens.Lens' UpdateEndpoint Prelude.Text
updateEndpoint_endpointName :: Lens' UpdateEndpoint Text
updateEndpoint_endpointName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEndpoint' {Text
endpointName :: Text
$sel:endpointName:UpdateEndpoint' :: UpdateEndpoint -> Text
endpointName} -> Text
endpointName) (\s :: UpdateEndpoint
s@UpdateEndpoint' {} Text
a -> UpdateEndpoint
s {$sel:endpointName:UpdateEndpoint' :: Text
endpointName = Text
a} :: UpdateEndpoint)

-- | The name of the new endpoint configuration.
updateEndpoint_endpointConfigName :: Lens.Lens' UpdateEndpoint Prelude.Text
updateEndpoint_endpointConfigName :: Lens' UpdateEndpoint Text
updateEndpoint_endpointConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEndpoint' {Text
endpointConfigName :: Text
$sel:endpointConfigName:UpdateEndpoint' :: UpdateEndpoint -> Text
endpointConfigName} -> Text
endpointConfigName) (\s :: UpdateEndpoint
s@UpdateEndpoint' {} Text
a -> UpdateEndpoint
s {$sel:endpointConfigName:UpdateEndpoint' :: Text
endpointConfigName = Text
a} :: UpdateEndpoint)

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

instance Prelude.Hashable UpdateEndpoint where
  hashWithSalt :: Int -> UpdateEndpoint -> Int
hashWithSalt Int
_salt UpdateEndpoint' {Maybe Bool
Maybe [VariantProperty]
Maybe DeploymentConfig
Text
endpointConfigName :: Text
endpointName :: Text
retainDeploymentConfig :: Maybe Bool
retainAllVariantProperties :: Maybe Bool
excludeRetainedVariantProperties :: Maybe [VariantProperty]
deploymentConfig :: Maybe DeploymentConfig
$sel:endpointConfigName:UpdateEndpoint' :: UpdateEndpoint -> Text
$sel:endpointName:UpdateEndpoint' :: UpdateEndpoint -> Text
$sel:retainDeploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
$sel:retainAllVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
$sel:excludeRetainedVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe [VariantProperty]
$sel:deploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe DeploymentConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeploymentConfig
deploymentConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [VariantProperty]
excludeRetainedVariantProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
retainAllVariantProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
retainDeploymentConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointConfigName

instance Prelude.NFData UpdateEndpoint where
  rnf :: UpdateEndpoint -> ()
rnf UpdateEndpoint' {Maybe Bool
Maybe [VariantProperty]
Maybe DeploymentConfig
Text
endpointConfigName :: Text
endpointName :: Text
retainDeploymentConfig :: Maybe Bool
retainAllVariantProperties :: Maybe Bool
excludeRetainedVariantProperties :: Maybe [VariantProperty]
deploymentConfig :: Maybe DeploymentConfig
$sel:endpointConfigName:UpdateEndpoint' :: UpdateEndpoint -> Text
$sel:endpointName:UpdateEndpoint' :: UpdateEndpoint -> Text
$sel:retainDeploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
$sel:retainAllVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
$sel:excludeRetainedVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe [VariantProperty]
$sel:deploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe DeploymentConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentConfig
deploymentConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [VariantProperty]
excludeRetainedVariantProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
retainAllVariantProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
retainDeploymentConfig
      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 Text
endpointConfigName

instance Data.ToHeaders UpdateEndpoint where
  toHeaders :: UpdateEndpoint -> 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.UpdateEndpoint" :: 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 UpdateEndpoint where
  toJSON :: UpdateEndpoint -> Value
toJSON UpdateEndpoint' {Maybe Bool
Maybe [VariantProperty]
Maybe DeploymentConfig
Text
endpointConfigName :: Text
endpointName :: Text
retainDeploymentConfig :: Maybe Bool
retainAllVariantProperties :: Maybe Bool
excludeRetainedVariantProperties :: Maybe [VariantProperty]
deploymentConfig :: Maybe DeploymentConfig
$sel:endpointConfigName:UpdateEndpoint' :: UpdateEndpoint -> Text
$sel:endpointName:UpdateEndpoint' :: UpdateEndpoint -> Text
$sel:retainDeploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
$sel:retainAllVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe Bool
$sel:excludeRetainedVariantProperties:UpdateEndpoint' :: UpdateEndpoint -> Maybe [VariantProperty]
$sel:deploymentConfig:UpdateEndpoint' :: UpdateEndpoint -> Maybe DeploymentConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeploymentConfig" 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 DeploymentConfig
deploymentConfig,
            (Key
"ExcludeRetainedVariantProperties" 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 [VariantProperty]
excludeRetainedVariantProperties,
            (Key
"RetainAllVariantProperties" 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 Bool
retainAllVariantProperties,
            (Key
"RetainDeploymentConfig" 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 Bool
retainDeploymentConfig,
            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
"EndpointConfigName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointConfigName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateEndpointResponse' 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', 'updateEndpointResponse_httpStatus' - The response's http status code.
--
-- 'endpointArn', 'updateEndpointResponse_endpointArn' - The Amazon Resource Name (ARN) of the endpoint.
newUpdateEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'endpointArn'
  Prelude.Text ->
  UpdateEndpointResponse
newUpdateEndpointResponse :: Int -> Text -> UpdateEndpointResponse
newUpdateEndpointResponse Int
pHttpStatus_ Text
pEndpointArn_ =
  UpdateEndpointResponse'
    { $sel:httpStatus:UpdateEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:endpointArn:UpdateEndpointResponse' :: Text
endpointArn = Text
pEndpointArn_
    }

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

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

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