{-# 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.CodePipeline.StopPipelineExecution
-- 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 the specified pipeline execution. You choose to either stop the
-- pipeline execution by completing in-progress actions without starting
-- subsequent actions, or by abandoning in-progress actions. While
-- completing or abandoning in-progress actions, the pipeline execution is
-- in a @Stopping@ state. After all in-progress actions are completed or
-- abandoned, the pipeline execution is in a @Stopped@ state.
module Amazonka.CodePipeline.StopPipelineExecution
  ( -- * Creating a Request
    StopPipelineExecution (..),
    newStopPipelineExecution,

    -- * Request Lenses
    stopPipelineExecution_abandon,
    stopPipelineExecution_reason,
    stopPipelineExecution_pipelineName,
    stopPipelineExecution_pipelineExecutionId,

    -- * Destructuring the Response
    StopPipelineExecutionResponse (..),
    newStopPipelineExecutionResponse,

    -- * Response Lenses
    stopPipelineExecutionResponse_pipelineExecutionId,
    stopPipelineExecutionResponse_httpStatus,
  )
where

import Amazonka.CodePipeline.Types
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

-- | /See:/ 'newStopPipelineExecution' smart constructor.
data StopPipelineExecution = StopPipelineExecution'
  { -- | Use this option to stop the pipeline execution by abandoning, rather
    -- than finishing, in-progress actions.
    --
    -- This option can lead to failed or out-of-sequence tasks.
    StopPipelineExecution -> Maybe Bool
abandon :: Prelude.Maybe Prelude.Bool,
    -- | Use this option to enter comments, such as the reason the pipeline was
    -- stopped.
    StopPipelineExecution -> Maybe Text
reason :: Prelude.Maybe Prelude.Text,
    -- | The name of the pipeline to stop.
    StopPipelineExecution -> Text
pipelineName :: Prelude.Text,
    -- | The ID of the pipeline execution to be stopped in the current stage. Use
    -- the @GetPipelineState@ action to retrieve the current
    -- pipelineExecutionId.
    StopPipelineExecution -> Text
pipelineExecutionId :: Prelude.Text
  }
  deriving (StopPipelineExecution -> StopPipelineExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopPipelineExecution -> StopPipelineExecution -> Bool
$c/= :: StopPipelineExecution -> StopPipelineExecution -> Bool
== :: StopPipelineExecution -> StopPipelineExecution -> Bool
$c== :: StopPipelineExecution -> StopPipelineExecution -> Bool
Prelude.Eq, ReadPrec [StopPipelineExecution]
ReadPrec StopPipelineExecution
Int -> ReadS StopPipelineExecution
ReadS [StopPipelineExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopPipelineExecution]
$creadListPrec :: ReadPrec [StopPipelineExecution]
readPrec :: ReadPrec StopPipelineExecution
$creadPrec :: ReadPrec StopPipelineExecution
readList :: ReadS [StopPipelineExecution]
$creadList :: ReadS [StopPipelineExecution]
readsPrec :: Int -> ReadS StopPipelineExecution
$creadsPrec :: Int -> ReadS StopPipelineExecution
Prelude.Read, Int -> StopPipelineExecution -> ShowS
[StopPipelineExecution] -> ShowS
StopPipelineExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopPipelineExecution] -> ShowS
$cshowList :: [StopPipelineExecution] -> ShowS
show :: StopPipelineExecution -> String
$cshow :: StopPipelineExecution -> String
showsPrec :: Int -> StopPipelineExecution -> ShowS
$cshowsPrec :: Int -> StopPipelineExecution -> ShowS
Prelude.Show, forall x. Rep StopPipelineExecution x -> StopPipelineExecution
forall x. StopPipelineExecution -> Rep StopPipelineExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopPipelineExecution x -> StopPipelineExecution
$cfrom :: forall x. StopPipelineExecution -> Rep StopPipelineExecution x
Prelude.Generic)

-- |
-- Create a value of 'StopPipelineExecution' 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:
--
-- 'abandon', 'stopPipelineExecution_abandon' - Use this option to stop the pipeline execution by abandoning, rather
-- than finishing, in-progress actions.
--
-- This option can lead to failed or out-of-sequence tasks.
--
-- 'reason', 'stopPipelineExecution_reason' - Use this option to enter comments, such as the reason the pipeline was
-- stopped.
--
-- 'pipelineName', 'stopPipelineExecution_pipelineName' - The name of the pipeline to stop.
--
-- 'pipelineExecutionId', 'stopPipelineExecution_pipelineExecutionId' - The ID of the pipeline execution to be stopped in the current stage. Use
-- the @GetPipelineState@ action to retrieve the current
-- pipelineExecutionId.
newStopPipelineExecution ::
  -- | 'pipelineName'
  Prelude.Text ->
  -- | 'pipelineExecutionId'
  Prelude.Text ->
  StopPipelineExecution
newStopPipelineExecution :: Text -> Text -> StopPipelineExecution
newStopPipelineExecution
  Text
pPipelineName_
  Text
pPipelineExecutionId_ =
    StopPipelineExecution'
      { $sel:abandon:StopPipelineExecution' :: Maybe Bool
abandon = forall a. Maybe a
Prelude.Nothing,
        $sel:reason:StopPipelineExecution' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing,
        $sel:pipelineName:StopPipelineExecution' :: Text
pipelineName = Text
pPipelineName_,
        $sel:pipelineExecutionId:StopPipelineExecution' :: Text
pipelineExecutionId = Text
pPipelineExecutionId_
      }

-- | Use this option to stop the pipeline execution by abandoning, rather
-- than finishing, in-progress actions.
--
-- This option can lead to failed or out-of-sequence tasks.
stopPipelineExecution_abandon :: Lens.Lens' StopPipelineExecution (Prelude.Maybe Prelude.Bool)
stopPipelineExecution_abandon :: Lens' StopPipelineExecution (Maybe Bool)
stopPipelineExecution_abandon = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopPipelineExecution' {Maybe Bool
abandon :: Maybe Bool
$sel:abandon:StopPipelineExecution' :: StopPipelineExecution -> Maybe Bool
abandon} -> Maybe Bool
abandon) (\s :: StopPipelineExecution
s@StopPipelineExecution' {} Maybe Bool
a -> StopPipelineExecution
s {$sel:abandon:StopPipelineExecution' :: Maybe Bool
abandon = Maybe Bool
a} :: StopPipelineExecution)

-- | Use this option to enter comments, such as the reason the pipeline was
-- stopped.
stopPipelineExecution_reason :: Lens.Lens' StopPipelineExecution (Prelude.Maybe Prelude.Text)
stopPipelineExecution_reason :: Lens' StopPipelineExecution (Maybe Text)
stopPipelineExecution_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopPipelineExecution' {Maybe Text
reason :: Maybe Text
$sel:reason:StopPipelineExecution' :: StopPipelineExecution -> Maybe Text
reason} -> Maybe Text
reason) (\s :: StopPipelineExecution
s@StopPipelineExecution' {} Maybe Text
a -> StopPipelineExecution
s {$sel:reason:StopPipelineExecution' :: Maybe Text
reason = Maybe Text
a} :: StopPipelineExecution)

-- | The name of the pipeline to stop.
stopPipelineExecution_pipelineName :: Lens.Lens' StopPipelineExecution Prelude.Text
stopPipelineExecution_pipelineName :: Lens' StopPipelineExecution Text
stopPipelineExecution_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopPipelineExecution' {Text
pipelineName :: Text
$sel:pipelineName:StopPipelineExecution' :: StopPipelineExecution -> Text
pipelineName} -> Text
pipelineName) (\s :: StopPipelineExecution
s@StopPipelineExecution' {} Text
a -> StopPipelineExecution
s {$sel:pipelineName:StopPipelineExecution' :: Text
pipelineName = Text
a} :: StopPipelineExecution)

-- | The ID of the pipeline execution to be stopped in the current stage. Use
-- the @GetPipelineState@ action to retrieve the current
-- pipelineExecutionId.
stopPipelineExecution_pipelineExecutionId :: Lens.Lens' StopPipelineExecution Prelude.Text
stopPipelineExecution_pipelineExecutionId :: Lens' StopPipelineExecution Text
stopPipelineExecution_pipelineExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopPipelineExecution' {Text
pipelineExecutionId :: Text
$sel:pipelineExecutionId:StopPipelineExecution' :: StopPipelineExecution -> Text
pipelineExecutionId} -> Text
pipelineExecutionId) (\s :: StopPipelineExecution
s@StopPipelineExecution' {} Text
a -> StopPipelineExecution
s {$sel:pipelineExecutionId:StopPipelineExecution' :: Text
pipelineExecutionId = Text
a} :: StopPipelineExecution)

instance Core.AWSRequest StopPipelineExecution where
  type
    AWSResponse StopPipelineExecution =
      StopPipelineExecutionResponse
  request :: (Service -> Service)
-> StopPipelineExecution -> Request StopPipelineExecution
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 StopPipelineExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopPipelineExecution)))
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 -> StopPipelineExecutionResponse
StopPipelineExecutionResponse'
            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
"pipelineExecutionId")
            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 StopPipelineExecution where
  hashWithSalt :: Int -> StopPipelineExecution -> Int
hashWithSalt Int
_salt StopPipelineExecution' {Maybe Bool
Maybe Text
Text
pipelineExecutionId :: Text
pipelineName :: Text
reason :: Maybe Text
abandon :: Maybe Bool
$sel:pipelineExecutionId:StopPipelineExecution' :: StopPipelineExecution -> Text
$sel:pipelineName:StopPipelineExecution' :: StopPipelineExecution -> Text
$sel:reason:StopPipelineExecution' :: StopPipelineExecution -> Maybe Text
$sel:abandon:StopPipelineExecution' :: StopPipelineExecution -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
abandon
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineExecutionId

instance Prelude.NFData StopPipelineExecution where
  rnf :: StopPipelineExecution -> ()
rnf StopPipelineExecution' {Maybe Bool
Maybe Text
Text
pipelineExecutionId :: Text
pipelineName :: Text
reason :: Maybe Text
abandon :: Maybe Bool
$sel:pipelineExecutionId:StopPipelineExecution' :: StopPipelineExecution -> Text
$sel:pipelineName:StopPipelineExecution' :: StopPipelineExecution -> Text
$sel:reason:StopPipelineExecution' :: StopPipelineExecution -> Maybe Text
$sel:abandon:StopPipelineExecution' :: StopPipelineExecution -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
abandon
      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
pipelineName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
pipelineExecutionId

instance Data.ToHeaders StopPipelineExecution where
  toHeaders :: StopPipelineExecution -> 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
"CodePipeline_20150709.StopPipelineExecution" ::
                          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 StopPipelineExecution where
  toJSON :: StopPipelineExecution -> Value
toJSON StopPipelineExecution' {Maybe Bool
Maybe Text
Text
pipelineExecutionId :: Text
pipelineName :: Text
reason :: Maybe Text
abandon :: Maybe Bool
$sel:pipelineExecutionId:StopPipelineExecution' :: StopPipelineExecution -> Text
$sel:pipelineName:StopPipelineExecution' :: StopPipelineExecution -> Text
$sel:reason:StopPipelineExecution' :: StopPipelineExecution -> Maybe Text
$sel:abandon:StopPipelineExecution' :: StopPipelineExecution -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"abandon" 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
abandon,
            (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
"pipelineName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pipelineName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"pipelineExecutionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pipelineExecutionId)
          ]
      )

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

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

-- | /See:/ 'newStopPipelineExecutionResponse' smart constructor.
data StopPipelineExecutionResponse = StopPipelineExecutionResponse'
  { -- | The unique system-generated ID of the pipeline execution that was
    -- stopped.
    StopPipelineExecutionResponse -> Maybe Text
pipelineExecutionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StopPipelineExecutionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StopPipelineExecutionResponse
-> StopPipelineExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopPipelineExecutionResponse
-> StopPipelineExecutionResponse -> Bool
$c/= :: StopPipelineExecutionResponse
-> StopPipelineExecutionResponse -> Bool
== :: StopPipelineExecutionResponse
-> StopPipelineExecutionResponse -> Bool
$c== :: StopPipelineExecutionResponse
-> StopPipelineExecutionResponse -> Bool
Prelude.Eq, ReadPrec [StopPipelineExecutionResponse]
ReadPrec StopPipelineExecutionResponse
Int -> ReadS StopPipelineExecutionResponse
ReadS [StopPipelineExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopPipelineExecutionResponse]
$creadListPrec :: ReadPrec [StopPipelineExecutionResponse]
readPrec :: ReadPrec StopPipelineExecutionResponse
$creadPrec :: ReadPrec StopPipelineExecutionResponse
readList :: ReadS [StopPipelineExecutionResponse]
$creadList :: ReadS [StopPipelineExecutionResponse]
readsPrec :: Int -> ReadS StopPipelineExecutionResponse
$creadsPrec :: Int -> ReadS StopPipelineExecutionResponse
Prelude.Read, Int -> StopPipelineExecutionResponse -> ShowS
[StopPipelineExecutionResponse] -> ShowS
StopPipelineExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopPipelineExecutionResponse] -> ShowS
$cshowList :: [StopPipelineExecutionResponse] -> ShowS
show :: StopPipelineExecutionResponse -> String
$cshow :: StopPipelineExecutionResponse -> String
showsPrec :: Int -> StopPipelineExecutionResponse -> ShowS
$cshowsPrec :: Int -> StopPipelineExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep StopPipelineExecutionResponse x
-> StopPipelineExecutionResponse
forall x.
StopPipelineExecutionResponse
-> Rep StopPipelineExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopPipelineExecutionResponse x
-> StopPipelineExecutionResponse
$cfrom :: forall x.
StopPipelineExecutionResponse
-> Rep StopPipelineExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopPipelineExecutionResponse' 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:
--
-- 'pipelineExecutionId', 'stopPipelineExecutionResponse_pipelineExecutionId' - The unique system-generated ID of the pipeline execution that was
-- stopped.
--
-- 'httpStatus', 'stopPipelineExecutionResponse_httpStatus' - The response's http status code.
newStopPipelineExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopPipelineExecutionResponse
newStopPipelineExecutionResponse :: Int -> StopPipelineExecutionResponse
newStopPipelineExecutionResponse Int
pHttpStatus_ =
  StopPipelineExecutionResponse'
    { $sel:pipelineExecutionId:StopPipelineExecutionResponse' :: Maybe Text
pipelineExecutionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopPipelineExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique system-generated ID of the pipeline execution that was
-- stopped.
stopPipelineExecutionResponse_pipelineExecutionId :: Lens.Lens' StopPipelineExecutionResponse (Prelude.Maybe Prelude.Text)
stopPipelineExecutionResponse_pipelineExecutionId :: Lens' StopPipelineExecutionResponse (Maybe Text)
stopPipelineExecutionResponse_pipelineExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopPipelineExecutionResponse' {Maybe Text
pipelineExecutionId :: Maybe Text
$sel:pipelineExecutionId:StopPipelineExecutionResponse' :: StopPipelineExecutionResponse -> Maybe Text
pipelineExecutionId} -> Maybe Text
pipelineExecutionId) (\s :: StopPipelineExecutionResponse
s@StopPipelineExecutionResponse' {} Maybe Text
a -> StopPipelineExecutionResponse
s {$sel:pipelineExecutionId:StopPipelineExecutionResponse' :: Maybe Text
pipelineExecutionId = Maybe Text
a} :: StopPipelineExecutionResponse)

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

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