{-# 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.StopInferenceExperiment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops an inference experiment.
module Amazonka.SageMaker.StopInferenceExperiment
  ( -- * Creating a Request
    StopInferenceExperiment (..),
    newStopInferenceExperiment,

    -- * Request Lenses
    stopInferenceExperiment_desiredModelVariants,
    stopInferenceExperiment_desiredState,
    stopInferenceExperiment_reason,
    stopInferenceExperiment_name,
    stopInferenceExperiment_modelVariantActions,

    -- * Destructuring the Response
    StopInferenceExperimentResponse (..),
    newStopInferenceExperimentResponse,

    -- * Response Lenses
    stopInferenceExperimentResponse_httpStatus,
    stopInferenceExperimentResponse_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:/ 'newStopInferenceExperiment' smart constructor.
data StopInferenceExperiment = StopInferenceExperiment'
  { -- | An array of @ModelVariantConfig@ objects. There is one for each variant
    -- that you want to deploy after the inference experiment stops. Each
    -- @ModelVariantConfig@ describes the infrastructure configuration for
    -- deploying the corresponding variant.
    StopInferenceExperiment -> Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants :: Prelude.Maybe (Prelude.NonEmpty ModelVariantConfig),
    -- | The desired state of the experiment after stopping. The possible states
    -- are the following:
    --
    -- -   @Completed@: The experiment completed successfully
    --
    -- -   @Cancelled@: The experiment was canceled
    StopInferenceExperiment
-> Maybe InferenceExperimentStopDesiredState
desiredState :: Prelude.Maybe InferenceExperimentStopDesiredState,
    -- | The reason for stopping the experiment.
    StopInferenceExperiment -> Maybe Text
reason :: Prelude.Maybe Prelude.Text,
    -- | The name of the inference experiment to stop.
    StopInferenceExperiment -> Text
name :: Prelude.Text,
    -- | Array of key-value pairs, with names of variants mapped to actions. The
    -- possible actions are the following:
    --
    -- -   @Promote@ - Promote the shadow variant to a production variant
    --
    -- -   @Remove@ - Delete the variant
    --
    -- -   @Retain@ - Keep the variant as it is
    StopInferenceExperiment -> HashMap Text ModelVariantAction
modelVariantActions :: Prelude.HashMap Prelude.Text ModelVariantAction
  }
  deriving (StopInferenceExperiment -> StopInferenceExperiment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopInferenceExperiment -> StopInferenceExperiment -> Bool
$c/= :: StopInferenceExperiment -> StopInferenceExperiment -> Bool
== :: StopInferenceExperiment -> StopInferenceExperiment -> Bool
$c== :: StopInferenceExperiment -> StopInferenceExperiment -> Bool
Prelude.Eq, ReadPrec [StopInferenceExperiment]
ReadPrec StopInferenceExperiment
Int -> ReadS StopInferenceExperiment
ReadS [StopInferenceExperiment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopInferenceExperiment]
$creadListPrec :: ReadPrec [StopInferenceExperiment]
readPrec :: ReadPrec StopInferenceExperiment
$creadPrec :: ReadPrec StopInferenceExperiment
readList :: ReadS [StopInferenceExperiment]
$creadList :: ReadS [StopInferenceExperiment]
readsPrec :: Int -> ReadS StopInferenceExperiment
$creadsPrec :: Int -> ReadS StopInferenceExperiment
Prelude.Read, Int -> StopInferenceExperiment -> ShowS
[StopInferenceExperiment] -> ShowS
StopInferenceExperiment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopInferenceExperiment] -> ShowS
$cshowList :: [StopInferenceExperiment] -> ShowS
show :: StopInferenceExperiment -> String
$cshow :: StopInferenceExperiment -> String
showsPrec :: Int -> StopInferenceExperiment -> ShowS
$cshowsPrec :: Int -> StopInferenceExperiment -> ShowS
Prelude.Show, forall x. Rep StopInferenceExperiment x -> StopInferenceExperiment
forall x. StopInferenceExperiment -> Rep StopInferenceExperiment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopInferenceExperiment x -> StopInferenceExperiment
$cfrom :: forall x. StopInferenceExperiment -> Rep StopInferenceExperiment x
Prelude.Generic)

-- |
-- Create a value of 'StopInferenceExperiment' 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:
--
-- 'desiredModelVariants', 'stopInferenceExperiment_desiredModelVariants' - An array of @ModelVariantConfig@ objects. There is one for each variant
-- that you want to deploy after the inference experiment stops. Each
-- @ModelVariantConfig@ describes the infrastructure configuration for
-- deploying the corresponding variant.
--
-- 'desiredState', 'stopInferenceExperiment_desiredState' - The desired state of the experiment after stopping. The possible states
-- are the following:
--
-- -   @Completed@: The experiment completed successfully
--
-- -   @Cancelled@: The experiment was canceled
--
-- 'reason', 'stopInferenceExperiment_reason' - The reason for stopping the experiment.
--
-- 'name', 'stopInferenceExperiment_name' - The name of the inference experiment to stop.
--
-- 'modelVariantActions', 'stopInferenceExperiment_modelVariantActions' - Array of key-value pairs, with names of variants mapped to actions. The
-- possible actions are the following:
--
-- -   @Promote@ - Promote the shadow variant to a production variant
--
-- -   @Remove@ - Delete the variant
--
-- -   @Retain@ - Keep the variant as it is
newStopInferenceExperiment ::
  -- | 'name'
  Prelude.Text ->
  StopInferenceExperiment
newStopInferenceExperiment :: Text -> StopInferenceExperiment
newStopInferenceExperiment Text
pName_ =
  StopInferenceExperiment'
    { $sel:desiredModelVariants:StopInferenceExperiment' :: Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants =
        forall a. Maybe a
Prelude.Nothing,
      $sel:desiredState:StopInferenceExperiment' :: Maybe InferenceExperimentStopDesiredState
desiredState = forall a. Maybe a
Prelude.Nothing,
      $sel:reason:StopInferenceExperiment' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing,
      $sel:name:StopInferenceExperiment' :: Text
name = Text
pName_,
      $sel:modelVariantActions:StopInferenceExperiment' :: HashMap Text ModelVariantAction
modelVariantActions = forall a. Monoid a => a
Prelude.mempty
    }

-- | An array of @ModelVariantConfig@ objects. There is one for each variant
-- that you want to deploy after the inference experiment stops. Each
-- @ModelVariantConfig@ describes the infrastructure configuration for
-- deploying the corresponding variant.
stopInferenceExperiment_desiredModelVariants :: Lens.Lens' StopInferenceExperiment (Prelude.Maybe (Prelude.NonEmpty ModelVariantConfig))
stopInferenceExperiment_desiredModelVariants :: Lens' StopInferenceExperiment (Maybe (NonEmpty ModelVariantConfig))
stopInferenceExperiment_desiredModelVariants = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInferenceExperiment' {Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants :: Maybe (NonEmpty ModelVariantConfig)
$sel:desiredModelVariants:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants} -> Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants) (\s :: StopInferenceExperiment
s@StopInferenceExperiment' {} Maybe (NonEmpty ModelVariantConfig)
a -> StopInferenceExperiment
s {$sel:desiredModelVariants:StopInferenceExperiment' :: Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants = Maybe (NonEmpty ModelVariantConfig)
a} :: StopInferenceExperiment) 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 desired state of the experiment after stopping. The possible states
-- are the following:
--
-- -   @Completed@: The experiment completed successfully
--
-- -   @Cancelled@: The experiment was canceled
stopInferenceExperiment_desiredState :: Lens.Lens' StopInferenceExperiment (Prelude.Maybe InferenceExperimentStopDesiredState)
stopInferenceExperiment_desiredState :: Lens'
  StopInferenceExperiment (Maybe InferenceExperimentStopDesiredState)
stopInferenceExperiment_desiredState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInferenceExperiment' {Maybe InferenceExperimentStopDesiredState
desiredState :: Maybe InferenceExperimentStopDesiredState
$sel:desiredState:StopInferenceExperiment' :: StopInferenceExperiment
-> Maybe InferenceExperimentStopDesiredState
desiredState} -> Maybe InferenceExperimentStopDesiredState
desiredState) (\s :: StopInferenceExperiment
s@StopInferenceExperiment' {} Maybe InferenceExperimentStopDesiredState
a -> StopInferenceExperiment
s {$sel:desiredState:StopInferenceExperiment' :: Maybe InferenceExperimentStopDesiredState
desiredState = Maybe InferenceExperimentStopDesiredState
a} :: StopInferenceExperiment)

-- | The reason for stopping the experiment.
stopInferenceExperiment_reason :: Lens.Lens' StopInferenceExperiment (Prelude.Maybe Prelude.Text)
stopInferenceExperiment_reason :: Lens' StopInferenceExperiment (Maybe Text)
stopInferenceExperiment_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInferenceExperiment' {Maybe Text
reason :: Maybe Text
$sel:reason:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe Text
reason} -> Maybe Text
reason) (\s :: StopInferenceExperiment
s@StopInferenceExperiment' {} Maybe Text
a -> StopInferenceExperiment
s {$sel:reason:StopInferenceExperiment' :: Maybe Text
reason = Maybe Text
a} :: StopInferenceExperiment)

-- | The name of the inference experiment to stop.
stopInferenceExperiment_name :: Lens.Lens' StopInferenceExperiment Prelude.Text
stopInferenceExperiment_name :: Lens' StopInferenceExperiment Text
stopInferenceExperiment_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInferenceExperiment' {Text
name :: Text
$sel:name:StopInferenceExperiment' :: StopInferenceExperiment -> Text
name} -> Text
name) (\s :: StopInferenceExperiment
s@StopInferenceExperiment' {} Text
a -> StopInferenceExperiment
s {$sel:name:StopInferenceExperiment' :: Text
name = Text
a} :: StopInferenceExperiment)

-- | Array of key-value pairs, with names of variants mapped to actions. The
-- possible actions are the following:
--
-- -   @Promote@ - Promote the shadow variant to a production variant
--
-- -   @Remove@ - Delete the variant
--
-- -   @Retain@ - Keep the variant as it is
stopInferenceExperiment_modelVariantActions :: Lens.Lens' StopInferenceExperiment (Prelude.HashMap Prelude.Text ModelVariantAction)
stopInferenceExperiment_modelVariantActions :: Lens' StopInferenceExperiment (HashMap Text ModelVariantAction)
stopInferenceExperiment_modelVariantActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInferenceExperiment' {HashMap Text ModelVariantAction
modelVariantActions :: HashMap Text ModelVariantAction
$sel:modelVariantActions:StopInferenceExperiment' :: StopInferenceExperiment -> HashMap Text ModelVariantAction
modelVariantActions} -> HashMap Text ModelVariantAction
modelVariantActions) (\s :: StopInferenceExperiment
s@StopInferenceExperiment' {} HashMap Text ModelVariantAction
a -> StopInferenceExperiment
s {$sel:modelVariantActions:StopInferenceExperiment' :: HashMap Text ModelVariantAction
modelVariantActions = HashMap Text ModelVariantAction
a} :: StopInferenceExperiment) 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 StopInferenceExperiment where
  type
    AWSResponse StopInferenceExperiment =
      StopInferenceExperimentResponse
  request :: (Service -> Service)
-> StopInferenceExperiment -> Request StopInferenceExperiment
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 StopInferenceExperiment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopInferenceExperiment)))
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 -> StopInferenceExperimentResponse
StopInferenceExperimentResponse'
            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 StopInferenceExperiment where
  hashWithSalt :: Int -> StopInferenceExperiment -> Int
hashWithSalt Int
_salt StopInferenceExperiment' {Maybe (NonEmpty ModelVariantConfig)
Maybe Text
Maybe InferenceExperimentStopDesiredState
Text
HashMap Text ModelVariantAction
modelVariantActions :: HashMap Text ModelVariantAction
name :: Text
reason :: Maybe Text
desiredState :: Maybe InferenceExperimentStopDesiredState
desiredModelVariants :: Maybe (NonEmpty ModelVariantConfig)
$sel:modelVariantActions:StopInferenceExperiment' :: StopInferenceExperiment -> HashMap Text ModelVariantAction
$sel:name:StopInferenceExperiment' :: StopInferenceExperiment -> Text
$sel:reason:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe Text
$sel:desiredState:StopInferenceExperiment' :: StopInferenceExperiment
-> Maybe InferenceExperimentStopDesiredState
$sel:desiredModelVariants:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe (NonEmpty ModelVariantConfig)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InferenceExperimentStopDesiredState
desiredState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text ModelVariantAction
modelVariantActions

instance Prelude.NFData StopInferenceExperiment where
  rnf :: StopInferenceExperiment -> ()
rnf StopInferenceExperiment' {Maybe (NonEmpty ModelVariantConfig)
Maybe Text
Maybe InferenceExperimentStopDesiredState
Text
HashMap Text ModelVariantAction
modelVariantActions :: HashMap Text ModelVariantAction
name :: Text
reason :: Maybe Text
desiredState :: Maybe InferenceExperimentStopDesiredState
desiredModelVariants :: Maybe (NonEmpty ModelVariantConfig)
$sel:modelVariantActions:StopInferenceExperiment' :: StopInferenceExperiment -> HashMap Text ModelVariantAction
$sel:name:StopInferenceExperiment' :: StopInferenceExperiment -> Text
$sel:reason:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe Text
$sel:desiredState:StopInferenceExperiment' :: StopInferenceExperiment
-> Maybe InferenceExperimentStopDesiredState
$sel:desiredModelVariants:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe (NonEmpty ModelVariantConfig)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ModelVariantConfig)
desiredModelVariants
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InferenceExperimentStopDesiredState
desiredState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reason
      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 HashMap Text ModelVariantAction
modelVariantActions

instance Data.ToHeaders StopInferenceExperiment where
  toHeaders :: StopInferenceExperiment -> 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.StopInferenceExperiment" ::
                          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 StopInferenceExperiment where
  toJSON :: StopInferenceExperiment -> Value
toJSON StopInferenceExperiment' {Maybe (NonEmpty ModelVariantConfig)
Maybe Text
Maybe InferenceExperimentStopDesiredState
Text
HashMap Text ModelVariantAction
modelVariantActions :: HashMap Text ModelVariantAction
name :: Text
reason :: Maybe Text
desiredState :: Maybe InferenceExperimentStopDesiredState
desiredModelVariants :: Maybe (NonEmpty ModelVariantConfig)
$sel:modelVariantActions:StopInferenceExperiment' :: StopInferenceExperiment -> HashMap Text ModelVariantAction
$sel:name:StopInferenceExperiment' :: StopInferenceExperiment -> Text
$sel:reason:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe Text
$sel:desiredState:StopInferenceExperiment' :: StopInferenceExperiment
-> Maybe InferenceExperimentStopDesiredState
$sel:desiredModelVariants:StopInferenceExperiment' :: StopInferenceExperiment -> Maybe (NonEmpty ModelVariantConfig)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DesiredModelVariants" 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 ModelVariantConfig)
desiredModelVariants,
            (Key
"DesiredState" 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 InferenceExperimentStopDesiredState
desiredState,
            (Key
"Reason" 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
reason,
            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
"ModelVariantActions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text ModelVariantAction
modelVariantActions)
          ]
      )

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

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

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

-- |
-- Create a value of 'StopInferenceExperimentResponse' 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', 'stopInferenceExperimentResponse_httpStatus' - The response's http status code.
--
-- 'inferenceExperimentArn', 'stopInferenceExperimentResponse_inferenceExperimentArn' - The ARN of the stopped inference experiment.
newStopInferenceExperimentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'inferenceExperimentArn'
  Prelude.Text ->
  StopInferenceExperimentResponse
newStopInferenceExperimentResponse :: Int -> Text -> StopInferenceExperimentResponse
newStopInferenceExperimentResponse
  Int
pHttpStatus_
  Text
pInferenceExperimentArn_ =
    StopInferenceExperimentResponse'
      { $sel:httpStatus:StopInferenceExperimentResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:inferenceExperimentArn:StopInferenceExperimentResponse' :: Text
inferenceExperimentArn =
          Text
pInferenceExperimentArn_
      }

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

-- | The ARN of the stopped inference experiment.
stopInferenceExperimentResponse_inferenceExperimentArn :: Lens.Lens' StopInferenceExperimentResponse Prelude.Text
stopInferenceExperimentResponse_inferenceExperimentArn :: Lens' StopInferenceExperimentResponse Text
stopInferenceExperimentResponse_inferenceExperimentArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopInferenceExperimentResponse' {Text
inferenceExperimentArn :: Text
$sel:inferenceExperimentArn:StopInferenceExperimentResponse' :: StopInferenceExperimentResponse -> Text
inferenceExperimentArn} -> Text
inferenceExperimentArn) (\s :: StopInferenceExperimentResponse
s@StopInferenceExperimentResponse' {} Text
a -> StopInferenceExperimentResponse
s {$sel:inferenceExperimentArn:StopInferenceExperimentResponse' :: Text
inferenceExperimentArn = Text
a} :: StopInferenceExperimentResponse)

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