{-# 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.SendPipelineExecutionStepSuccess
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Notifies the pipeline that the execution of a callback step succeeded
-- and provides a list of the step\'s output parameters. When a callback
-- step is run, the pipeline generates a callback token and includes the
-- token in a message sent to Amazon Simple Queue Service (Amazon SQS).
module Amazonka.SageMaker.SendPipelineExecutionStepSuccess
  ( -- * Creating a Request
    SendPipelineExecutionStepSuccess (..),
    newSendPipelineExecutionStepSuccess,

    -- * Request Lenses
    sendPipelineExecutionStepSuccess_clientRequestToken,
    sendPipelineExecutionStepSuccess_outputParameters,
    sendPipelineExecutionStepSuccess_callbackToken,

    -- * Destructuring the Response
    SendPipelineExecutionStepSuccessResponse (..),
    newSendPipelineExecutionStepSuccessResponse,

    -- * Response Lenses
    sendPipelineExecutionStepSuccessResponse_pipelineExecutionArn,
    sendPipelineExecutionStepSuccessResponse_httpStatus,
  )
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:/ 'newSendPipelineExecutionStepSuccess' smart constructor.
data SendPipelineExecutionStepSuccess = SendPipelineExecutionStepSuccess'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the operation. An idempotent operation completes no more
    -- than one time.
    SendPipelineExecutionStepSuccess -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A list of the output parameters of the callback step.
    SendPipelineExecutionStepSuccess -> Maybe [OutputParameter]
outputParameters :: Prelude.Maybe [OutputParameter],
    -- | The pipeline generated token from the Amazon SQS queue.
    SendPipelineExecutionStepSuccess -> Text
callbackToken :: Prelude.Text
  }
  deriving (SendPipelineExecutionStepSuccess
-> SendPipelineExecutionStepSuccess -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendPipelineExecutionStepSuccess
-> SendPipelineExecutionStepSuccess -> Bool
$c/= :: SendPipelineExecutionStepSuccess
-> SendPipelineExecutionStepSuccess -> Bool
== :: SendPipelineExecutionStepSuccess
-> SendPipelineExecutionStepSuccess -> Bool
$c== :: SendPipelineExecutionStepSuccess
-> SendPipelineExecutionStepSuccess -> Bool
Prelude.Eq, ReadPrec [SendPipelineExecutionStepSuccess]
ReadPrec SendPipelineExecutionStepSuccess
Int -> ReadS SendPipelineExecutionStepSuccess
ReadS [SendPipelineExecutionStepSuccess]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendPipelineExecutionStepSuccess]
$creadListPrec :: ReadPrec [SendPipelineExecutionStepSuccess]
readPrec :: ReadPrec SendPipelineExecutionStepSuccess
$creadPrec :: ReadPrec SendPipelineExecutionStepSuccess
readList :: ReadS [SendPipelineExecutionStepSuccess]
$creadList :: ReadS [SendPipelineExecutionStepSuccess]
readsPrec :: Int -> ReadS SendPipelineExecutionStepSuccess
$creadsPrec :: Int -> ReadS SendPipelineExecutionStepSuccess
Prelude.Read, Int -> SendPipelineExecutionStepSuccess -> ShowS
[SendPipelineExecutionStepSuccess] -> ShowS
SendPipelineExecutionStepSuccess -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendPipelineExecutionStepSuccess] -> ShowS
$cshowList :: [SendPipelineExecutionStepSuccess] -> ShowS
show :: SendPipelineExecutionStepSuccess -> String
$cshow :: SendPipelineExecutionStepSuccess -> String
showsPrec :: Int -> SendPipelineExecutionStepSuccess -> ShowS
$cshowsPrec :: Int -> SendPipelineExecutionStepSuccess -> ShowS
Prelude.Show, forall x.
Rep SendPipelineExecutionStepSuccess x
-> SendPipelineExecutionStepSuccess
forall x.
SendPipelineExecutionStepSuccess
-> Rep SendPipelineExecutionStepSuccess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendPipelineExecutionStepSuccess x
-> SendPipelineExecutionStepSuccess
$cfrom :: forall x.
SendPipelineExecutionStepSuccess
-> Rep SendPipelineExecutionStepSuccess x
Prelude.Generic)

-- |
-- Create a value of 'SendPipelineExecutionStepSuccess' 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:
--
-- 'clientRequestToken', 'sendPipelineExecutionStepSuccess_clientRequestToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the operation. An idempotent operation completes no more
-- than one time.
--
-- 'outputParameters', 'sendPipelineExecutionStepSuccess_outputParameters' - A list of the output parameters of the callback step.
--
-- 'callbackToken', 'sendPipelineExecutionStepSuccess_callbackToken' - The pipeline generated token from the Amazon SQS queue.
newSendPipelineExecutionStepSuccess ::
  -- | 'callbackToken'
  Prelude.Text ->
  SendPipelineExecutionStepSuccess
newSendPipelineExecutionStepSuccess :: Text -> SendPipelineExecutionStepSuccess
newSendPipelineExecutionStepSuccess Text
pCallbackToken_ =
  SendPipelineExecutionStepSuccess'
    { $sel:clientRequestToken:SendPipelineExecutionStepSuccess' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:outputParameters:SendPipelineExecutionStepSuccess' :: Maybe [OutputParameter]
outputParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:callbackToken:SendPipelineExecutionStepSuccess' :: Text
callbackToken = Text
pCallbackToken_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the operation. An idempotent operation completes no more
-- than one time.
sendPipelineExecutionStepSuccess_clientRequestToken :: Lens.Lens' SendPipelineExecutionStepSuccess (Prelude.Maybe Prelude.Text)
sendPipelineExecutionStepSuccess_clientRequestToken :: Lens' SendPipelineExecutionStepSuccess (Maybe Text)
sendPipelineExecutionStepSuccess_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendPipelineExecutionStepSuccess' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: SendPipelineExecutionStepSuccess
s@SendPipelineExecutionStepSuccess' {} Maybe Text
a -> SendPipelineExecutionStepSuccess
s {$sel:clientRequestToken:SendPipelineExecutionStepSuccess' :: Maybe Text
clientRequestToken = Maybe Text
a} :: SendPipelineExecutionStepSuccess)

-- | A list of the output parameters of the callback step.
sendPipelineExecutionStepSuccess_outputParameters :: Lens.Lens' SendPipelineExecutionStepSuccess (Prelude.Maybe [OutputParameter])
sendPipelineExecutionStepSuccess_outputParameters :: Lens' SendPipelineExecutionStepSuccess (Maybe [OutputParameter])
sendPipelineExecutionStepSuccess_outputParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendPipelineExecutionStepSuccess' {Maybe [OutputParameter]
outputParameters :: Maybe [OutputParameter]
$sel:outputParameters:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe [OutputParameter]
outputParameters} -> Maybe [OutputParameter]
outputParameters) (\s :: SendPipelineExecutionStepSuccess
s@SendPipelineExecutionStepSuccess' {} Maybe [OutputParameter]
a -> SendPipelineExecutionStepSuccess
s {$sel:outputParameters:SendPipelineExecutionStepSuccess' :: Maybe [OutputParameter]
outputParameters = Maybe [OutputParameter]
a} :: SendPipelineExecutionStepSuccess) 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 pipeline generated token from the Amazon SQS queue.
sendPipelineExecutionStepSuccess_callbackToken :: Lens.Lens' SendPipelineExecutionStepSuccess Prelude.Text
sendPipelineExecutionStepSuccess_callbackToken :: Lens' SendPipelineExecutionStepSuccess Text
sendPipelineExecutionStepSuccess_callbackToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendPipelineExecutionStepSuccess' {Text
callbackToken :: Text
$sel:callbackToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Text
callbackToken} -> Text
callbackToken) (\s :: SendPipelineExecutionStepSuccess
s@SendPipelineExecutionStepSuccess' {} Text
a -> SendPipelineExecutionStepSuccess
s {$sel:callbackToken:SendPipelineExecutionStepSuccess' :: Text
callbackToken = Text
a} :: SendPipelineExecutionStepSuccess)

instance
  Core.AWSRequest
    SendPipelineExecutionStepSuccess
  where
  type
    AWSResponse SendPipelineExecutionStepSuccess =
      SendPipelineExecutionStepSuccessResponse
  request :: (Service -> Service)
-> SendPipelineExecutionStepSuccess
-> Request SendPipelineExecutionStepSuccess
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 SendPipelineExecutionStepSuccess
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse SendPipelineExecutionStepSuccess)))
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 ->
          Maybe Text -> Int -> SendPipelineExecutionStepSuccessResponse
SendPipelineExecutionStepSuccessResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PipelineExecutionArn")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance
  Prelude.Hashable
    SendPipelineExecutionStepSuccess
  where
  hashWithSalt :: Int -> SendPipelineExecutionStepSuccess -> Int
hashWithSalt
    Int
_salt
    SendPipelineExecutionStepSuccess' {Maybe [OutputParameter]
Maybe Text
Text
callbackToken :: Text
outputParameters :: Maybe [OutputParameter]
clientRequestToken :: Maybe Text
$sel:callbackToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Text
$sel:outputParameters:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe [OutputParameter]
$sel:clientRequestToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [OutputParameter]
outputParameters
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
callbackToken

instance
  Prelude.NFData
    SendPipelineExecutionStepSuccess
  where
  rnf :: SendPipelineExecutionStepSuccess -> ()
rnf SendPipelineExecutionStepSuccess' {Maybe [OutputParameter]
Maybe Text
Text
callbackToken :: Text
outputParameters :: Maybe [OutputParameter]
clientRequestToken :: Maybe Text
$sel:callbackToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Text
$sel:outputParameters:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe [OutputParameter]
$sel:clientRequestToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OutputParameter]
outputParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
callbackToken

instance
  Data.ToHeaders
    SendPipelineExecutionStepSuccess
  where
  toHeaders :: SendPipelineExecutionStepSuccess -> 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.SendPipelineExecutionStepSuccess" ::
                          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 SendPipelineExecutionStepSuccess where
  toJSON :: SendPipelineExecutionStepSuccess -> Value
toJSON SendPipelineExecutionStepSuccess' {Maybe [OutputParameter]
Maybe Text
Text
callbackToken :: Text
outputParameters :: Maybe [OutputParameter]
clientRequestToken :: Maybe Text
$sel:callbackToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Text
$sel:outputParameters:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe [OutputParameter]
$sel:clientRequestToken:SendPipelineExecutionStepSuccess' :: SendPipelineExecutionStepSuccess -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"OutputParameters" 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 [OutputParameter]
outputParameters,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CallbackToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
callbackToken)
          ]
      )

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

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

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

-- |
-- Create a value of 'SendPipelineExecutionStepSuccessResponse' 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:
--
-- 'pipelineExecutionArn', 'sendPipelineExecutionStepSuccessResponse_pipelineExecutionArn' - The Amazon Resource Name (ARN) of the pipeline execution.
--
-- 'httpStatus', 'sendPipelineExecutionStepSuccessResponse_httpStatus' - The response's http status code.
newSendPipelineExecutionStepSuccessResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendPipelineExecutionStepSuccessResponse
newSendPipelineExecutionStepSuccessResponse :: Int -> SendPipelineExecutionStepSuccessResponse
newSendPipelineExecutionStepSuccessResponse
  Int
pHttpStatus_ =
    SendPipelineExecutionStepSuccessResponse'
      { $sel:pipelineExecutionArn:SendPipelineExecutionStepSuccessResponse' :: Maybe Text
pipelineExecutionArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:SendPipelineExecutionStepSuccessResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The Amazon Resource Name (ARN) of the pipeline execution.
sendPipelineExecutionStepSuccessResponse_pipelineExecutionArn :: Lens.Lens' SendPipelineExecutionStepSuccessResponse (Prelude.Maybe Prelude.Text)
sendPipelineExecutionStepSuccessResponse_pipelineExecutionArn :: Lens' SendPipelineExecutionStepSuccessResponse (Maybe Text)
sendPipelineExecutionStepSuccessResponse_pipelineExecutionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendPipelineExecutionStepSuccessResponse' {Maybe Text
pipelineExecutionArn :: Maybe Text
$sel:pipelineExecutionArn:SendPipelineExecutionStepSuccessResponse' :: SendPipelineExecutionStepSuccessResponse -> Maybe Text
pipelineExecutionArn} -> Maybe Text
pipelineExecutionArn) (\s :: SendPipelineExecutionStepSuccessResponse
s@SendPipelineExecutionStepSuccessResponse' {} Maybe Text
a -> SendPipelineExecutionStepSuccessResponse
s {$sel:pipelineExecutionArn:SendPipelineExecutionStepSuccessResponse' :: Maybe Text
pipelineExecutionArn = Maybe Text
a} :: SendPipelineExecutionStepSuccessResponse)

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

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