{-# 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.RetryStageExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resumes the pipeline execution by retrying the last failed actions in a
-- stage. You can retry a stage immediately if any of the actions in the
-- stage fail. When you retry, all actions that are still in progress
-- continue working, and failed actions are triggered again.
module Amazonka.CodePipeline.RetryStageExecution
  ( -- * Creating a Request
    RetryStageExecution (..),
    newRetryStageExecution,

    -- * Request Lenses
    retryStageExecution_pipelineName,
    retryStageExecution_stageName,
    retryStageExecution_pipelineExecutionId,
    retryStageExecution_retryMode,

    -- * Destructuring the Response
    RetryStageExecutionResponse (..),
    newRetryStageExecutionResponse,

    -- * Response Lenses
    retryStageExecutionResponse_pipelineExecutionId,
    retryStageExecutionResponse_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

-- | Represents the input of a @RetryStageExecution@ action.
--
-- /See:/ 'newRetryStageExecution' smart constructor.
data RetryStageExecution = RetryStageExecution'
  { -- | The name of the pipeline that contains the failed stage.
    RetryStageExecution -> Text
pipelineName :: Prelude.Text,
    -- | The name of the failed stage to be retried.
    RetryStageExecution -> Text
stageName :: Prelude.Text,
    -- | The ID of the pipeline execution in the failed stage to be retried. Use
    -- the GetPipelineState action to retrieve the current pipelineExecutionId
    -- of the failed stage
    RetryStageExecution -> Text
pipelineExecutionId :: Prelude.Text,
    -- | The scope of the retry attempt. Currently, the only supported value is
    -- FAILED_ACTIONS.
    RetryStageExecution -> StageRetryMode
retryMode :: StageRetryMode
  }
  deriving (RetryStageExecution -> RetryStageExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetryStageExecution -> RetryStageExecution -> Bool
$c/= :: RetryStageExecution -> RetryStageExecution -> Bool
== :: RetryStageExecution -> RetryStageExecution -> Bool
$c== :: RetryStageExecution -> RetryStageExecution -> Bool
Prelude.Eq, ReadPrec [RetryStageExecution]
ReadPrec RetryStageExecution
Int -> ReadS RetryStageExecution
ReadS [RetryStageExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RetryStageExecution]
$creadListPrec :: ReadPrec [RetryStageExecution]
readPrec :: ReadPrec RetryStageExecution
$creadPrec :: ReadPrec RetryStageExecution
readList :: ReadS [RetryStageExecution]
$creadList :: ReadS [RetryStageExecution]
readsPrec :: Int -> ReadS RetryStageExecution
$creadsPrec :: Int -> ReadS RetryStageExecution
Prelude.Read, Int -> RetryStageExecution -> ShowS
[RetryStageExecution] -> ShowS
RetryStageExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetryStageExecution] -> ShowS
$cshowList :: [RetryStageExecution] -> ShowS
show :: RetryStageExecution -> String
$cshow :: RetryStageExecution -> String
showsPrec :: Int -> RetryStageExecution -> ShowS
$cshowsPrec :: Int -> RetryStageExecution -> ShowS
Prelude.Show, forall x. Rep RetryStageExecution x -> RetryStageExecution
forall x. RetryStageExecution -> Rep RetryStageExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RetryStageExecution x -> RetryStageExecution
$cfrom :: forall x. RetryStageExecution -> Rep RetryStageExecution x
Prelude.Generic)

-- |
-- Create a value of 'RetryStageExecution' 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:
--
-- 'pipelineName', 'retryStageExecution_pipelineName' - The name of the pipeline that contains the failed stage.
--
-- 'stageName', 'retryStageExecution_stageName' - The name of the failed stage to be retried.
--
-- 'pipelineExecutionId', 'retryStageExecution_pipelineExecutionId' - The ID of the pipeline execution in the failed stage to be retried. Use
-- the GetPipelineState action to retrieve the current pipelineExecutionId
-- of the failed stage
--
-- 'retryMode', 'retryStageExecution_retryMode' - The scope of the retry attempt. Currently, the only supported value is
-- FAILED_ACTIONS.
newRetryStageExecution ::
  -- | 'pipelineName'
  Prelude.Text ->
  -- | 'stageName'
  Prelude.Text ->
  -- | 'pipelineExecutionId'
  Prelude.Text ->
  -- | 'retryMode'
  StageRetryMode ->
  RetryStageExecution
newRetryStageExecution :: Text -> Text -> Text -> StageRetryMode -> RetryStageExecution
newRetryStageExecution
  Text
pPipelineName_
  Text
pStageName_
  Text
pPipelineExecutionId_
  StageRetryMode
pRetryMode_ =
    RetryStageExecution'
      { $sel:pipelineName:RetryStageExecution' :: Text
pipelineName = Text
pPipelineName_,
        $sel:stageName:RetryStageExecution' :: Text
stageName = Text
pStageName_,
        $sel:pipelineExecutionId:RetryStageExecution' :: Text
pipelineExecutionId = Text
pPipelineExecutionId_,
        $sel:retryMode:RetryStageExecution' :: StageRetryMode
retryMode = StageRetryMode
pRetryMode_
      }

-- | The name of the pipeline that contains the failed stage.
retryStageExecution_pipelineName :: Lens.Lens' RetryStageExecution Prelude.Text
retryStageExecution_pipelineName :: Lens' RetryStageExecution Text
retryStageExecution_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetryStageExecution' {Text
pipelineName :: Text
$sel:pipelineName:RetryStageExecution' :: RetryStageExecution -> Text
pipelineName} -> Text
pipelineName) (\s :: RetryStageExecution
s@RetryStageExecution' {} Text
a -> RetryStageExecution
s {$sel:pipelineName:RetryStageExecution' :: Text
pipelineName = Text
a} :: RetryStageExecution)

-- | The name of the failed stage to be retried.
retryStageExecution_stageName :: Lens.Lens' RetryStageExecution Prelude.Text
retryStageExecution_stageName :: Lens' RetryStageExecution Text
retryStageExecution_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetryStageExecution' {Text
stageName :: Text
$sel:stageName:RetryStageExecution' :: RetryStageExecution -> Text
stageName} -> Text
stageName) (\s :: RetryStageExecution
s@RetryStageExecution' {} Text
a -> RetryStageExecution
s {$sel:stageName:RetryStageExecution' :: Text
stageName = Text
a} :: RetryStageExecution)

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

-- | The scope of the retry attempt. Currently, the only supported value is
-- FAILED_ACTIONS.
retryStageExecution_retryMode :: Lens.Lens' RetryStageExecution StageRetryMode
retryStageExecution_retryMode :: Lens' RetryStageExecution StageRetryMode
retryStageExecution_retryMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetryStageExecution' {StageRetryMode
retryMode :: StageRetryMode
$sel:retryMode:RetryStageExecution' :: RetryStageExecution -> StageRetryMode
retryMode} -> StageRetryMode
retryMode) (\s :: RetryStageExecution
s@RetryStageExecution' {} StageRetryMode
a -> RetryStageExecution
s {$sel:retryMode:RetryStageExecution' :: StageRetryMode
retryMode = StageRetryMode
a} :: RetryStageExecution)

instance Core.AWSRequest RetryStageExecution where
  type
    AWSResponse RetryStageExecution =
      RetryStageExecutionResponse
  request :: (Service -> Service)
-> RetryStageExecution -> Request RetryStageExecution
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 RetryStageExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RetryStageExecution)))
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 -> RetryStageExecutionResponse
RetryStageExecutionResponse'
            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 RetryStageExecution where
  hashWithSalt :: Int -> RetryStageExecution -> Int
hashWithSalt Int
_salt RetryStageExecution' {Text
StageRetryMode
retryMode :: StageRetryMode
pipelineExecutionId :: Text
stageName :: Text
pipelineName :: Text
$sel:retryMode:RetryStageExecution' :: RetryStageExecution -> StageRetryMode
$sel:pipelineExecutionId:RetryStageExecution' :: RetryStageExecution -> Text
$sel:stageName:RetryStageExecution' :: RetryStageExecution -> Text
$sel:pipelineName:RetryStageExecution' :: RetryStageExecution -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineExecutionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StageRetryMode
retryMode

instance Prelude.NFData RetryStageExecution where
  rnf :: RetryStageExecution -> ()
rnf RetryStageExecution' {Text
StageRetryMode
retryMode :: StageRetryMode
pipelineExecutionId :: Text
stageName :: Text
pipelineName :: Text
$sel:retryMode:RetryStageExecution' :: RetryStageExecution -> StageRetryMode
$sel:pipelineExecutionId:RetryStageExecution' :: RetryStageExecution -> Text
$sel:stageName:RetryStageExecution' :: RetryStageExecution -> Text
$sel:pipelineName:RetryStageExecution' :: RetryStageExecution -> Text
..} =
    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
stageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
pipelineExecutionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StageRetryMode
retryMode

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

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

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

-- | Represents the output of a @RetryStageExecution@ action.
--
-- /See:/ 'newRetryStageExecutionResponse' smart constructor.
data RetryStageExecutionResponse = RetryStageExecutionResponse'
  { -- | The ID of the current workflow execution in the failed stage.
    RetryStageExecutionResponse -> Maybe Text
pipelineExecutionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RetryStageExecutionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RetryStageExecutionResponse -> RetryStageExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetryStageExecutionResponse -> RetryStageExecutionResponse -> Bool
$c/= :: RetryStageExecutionResponse -> RetryStageExecutionResponse -> Bool
== :: RetryStageExecutionResponse -> RetryStageExecutionResponse -> Bool
$c== :: RetryStageExecutionResponse -> RetryStageExecutionResponse -> Bool
Prelude.Eq, ReadPrec [RetryStageExecutionResponse]
ReadPrec RetryStageExecutionResponse
Int -> ReadS RetryStageExecutionResponse
ReadS [RetryStageExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RetryStageExecutionResponse]
$creadListPrec :: ReadPrec [RetryStageExecutionResponse]
readPrec :: ReadPrec RetryStageExecutionResponse
$creadPrec :: ReadPrec RetryStageExecutionResponse
readList :: ReadS [RetryStageExecutionResponse]
$creadList :: ReadS [RetryStageExecutionResponse]
readsPrec :: Int -> ReadS RetryStageExecutionResponse
$creadsPrec :: Int -> ReadS RetryStageExecutionResponse
Prelude.Read, Int -> RetryStageExecutionResponse -> ShowS
[RetryStageExecutionResponse] -> ShowS
RetryStageExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetryStageExecutionResponse] -> ShowS
$cshowList :: [RetryStageExecutionResponse] -> ShowS
show :: RetryStageExecutionResponse -> String
$cshow :: RetryStageExecutionResponse -> String
showsPrec :: Int -> RetryStageExecutionResponse -> ShowS
$cshowsPrec :: Int -> RetryStageExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep RetryStageExecutionResponse x -> RetryStageExecutionResponse
forall x.
RetryStageExecutionResponse -> Rep RetryStageExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RetryStageExecutionResponse x -> RetryStageExecutionResponse
$cfrom :: forall x.
RetryStageExecutionResponse -> Rep RetryStageExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'RetryStageExecutionResponse' 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', 'retryStageExecutionResponse_pipelineExecutionId' - The ID of the current workflow execution in the failed stage.
--
-- 'httpStatus', 'retryStageExecutionResponse_httpStatus' - The response's http status code.
newRetryStageExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RetryStageExecutionResponse
newRetryStageExecutionResponse :: Int -> RetryStageExecutionResponse
newRetryStageExecutionResponse Int
pHttpStatus_ =
  RetryStageExecutionResponse'
    { $sel:pipelineExecutionId:RetryStageExecutionResponse' :: Maybe Text
pipelineExecutionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RetryStageExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the current workflow execution in the failed stage.
retryStageExecutionResponse_pipelineExecutionId :: Lens.Lens' RetryStageExecutionResponse (Prelude.Maybe Prelude.Text)
retryStageExecutionResponse_pipelineExecutionId :: Lens' RetryStageExecutionResponse (Maybe Text)
retryStageExecutionResponse_pipelineExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RetryStageExecutionResponse' {Maybe Text
pipelineExecutionId :: Maybe Text
$sel:pipelineExecutionId:RetryStageExecutionResponse' :: RetryStageExecutionResponse -> Maybe Text
pipelineExecutionId} -> Maybe Text
pipelineExecutionId) (\s :: RetryStageExecutionResponse
s@RetryStageExecutionResponse' {} Maybe Text
a -> RetryStageExecutionResponse
s {$sel:pipelineExecutionId:RetryStageExecutionResponse' :: Maybe Text
pipelineExecutionId = Maybe Text
a} :: RetryStageExecutionResponse)

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

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