{-# 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.CloudFormation.RollbackStack
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- When specifying @RollbackStack@, you preserve the state of previously
-- provisioned resources when an operation fails. You can check the status
-- of the stack through the DescribeStacks operation.
--
-- Rolls back the specified stack to the last known stable state from
-- @CREATE_FAILED@ or @UPDATE_FAILED@ stack statuses.
--
-- This operation will delete a stack if it doesn\'t contain a last known
-- stable state. A last known stable state includes any status in a
-- @*_COMPLETE@. This includes the following stack statuses.
--
-- -   @CREATE_COMPLETE@
--
-- -   @UPDATE_COMPLETE@
--
-- -   @UPDATE_ROLLBACK_COMPLETE@
--
-- -   @IMPORT_COMPLETE@
--
-- -   @IMPORT_ROLLBACK_COMPLETE@
module Amazonka.CloudFormation.RollbackStack
  ( -- * Creating a Request
    RollbackStack (..),
    newRollbackStack,

    -- * Request Lenses
    rollbackStack_clientRequestToken,
    rollbackStack_roleARN,
    rollbackStack_stackName,

    -- * Destructuring the Response
    RollbackStackResponse (..),
    newRollbackStackResponse,

    -- * Response Lenses
    rollbackStackResponse_stackId,
    rollbackStackResponse_httpStatus,
  )
where

import Amazonka.CloudFormation.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:/ 'newRollbackStack' smart constructor.
data RollbackStack = RollbackStack'
  { -- | A unique identifier for this @RollbackStack@ request.
    RollbackStack -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of an Identity and Access Management role
    -- that CloudFormation assumes to rollback the stack.
    RollbackStack -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text,
    -- | The name that\'s associated with the stack.
    RollbackStack -> Text
stackName :: Prelude.Text
  }
  deriving (RollbackStack -> RollbackStack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RollbackStack -> RollbackStack -> Bool
$c/= :: RollbackStack -> RollbackStack -> Bool
== :: RollbackStack -> RollbackStack -> Bool
$c== :: RollbackStack -> RollbackStack -> Bool
Prelude.Eq, ReadPrec [RollbackStack]
ReadPrec RollbackStack
Int -> ReadS RollbackStack
ReadS [RollbackStack]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RollbackStack]
$creadListPrec :: ReadPrec [RollbackStack]
readPrec :: ReadPrec RollbackStack
$creadPrec :: ReadPrec RollbackStack
readList :: ReadS [RollbackStack]
$creadList :: ReadS [RollbackStack]
readsPrec :: Int -> ReadS RollbackStack
$creadsPrec :: Int -> ReadS RollbackStack
Prelude.Read, Int -> RollbackStack -> ShowS
[RollbackStack] -> ShowS
RollbackStack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RollbackStack] -> ShowS
$cshowList :: [RollbackStack] -> ShowS
show :: RollbackStack -> String
$cshow :: RollbackStack -> String
showsPrec :: Int -> RollbackStack -> ShowS
$cshowsPrec :: Int -> RollbackStack -> ShowS
Prelude.Show, forall x. Rep RollbackStack x -> RollbackStack
forall x. RollbackStack -> Rep RollbackStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RollbackStack x -> RollbackStack
$cfrom :: forall x. RollbackStack -> Rep RollbackStack x
Prelude.Generic)

-- |
-- Create a value of 'RollbackStack' 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', 'rollbackStack_clientRequestToken' - A unique identifier for this @RollbackStack@ request.
--
-- 'roleARN', 'rollbackStack_roleARN' - The Amazon Resource Name (ARN) of an Identity and Access Management role
-- that CloudFormation assumes to rollback the stack.
--
-- 'stackName', 'rollbackStack_stackName' - The name that\'s associated with the stack.
newRollbackStack ::
  -- | 'stackName'
  Prelude.Text ->
  RollbackStack
newRollbackStack :: Text -> RollbackStack
newRollbackStack Text
pStackName_ =
  RollbackStack'
    { $sel:clientRequestToken:RollbackStack' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:RollbackStack' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing,
      $sel:stackName:RollbackStack' :: Text
stackName = Text
pStackName_
    }

-- | A unique identifier for this @RollbackStack@ request.
rollbackStack_clientRequestToken :: Lens.Lens' RollbackStack (Prelude.Maybe Prelude.Text)
rollbackStack_clientRequestToken :: Lens' RollbackStack (Maybe Text)
rollbackStack_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RollbackStack' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:RollbackStack' :: RollbackStack -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: RollbackStack
s@RollbackStack' {} Maybe Text
a -> RollbackStack
s {$sel:clientRequestToken:RollbackStack' :: Maybe Text
clientRequestToken = Maybe Text
a} :: RollbackStack)

-- | The Amazon Resource Name (ARN) of an Identity and Access Management role
-- that CloudFormation assumes to rollback the stack.
rollbackStack_roleARN :: Lens.Lens' RollbackStack (Prelude.Maybe Prelude.Text)
rollbackStack_roleARN :: Lens' RollbackStack (Maybe Text)
rollbackStack_roleARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RollbackStack' {Maybe Text
roleARN :: Maybe Text
$sel:roleARN:RollbackStack' :: RollbackStack -> Maybe Text
roleARN} -> Maybe Text
roleARN) (\s :: RollbackStack
s@RollbackStack' {} Maybe Text
a -> RollbackStack
s {$sel:roleARN:RollbackStack' :: Maybe Text
roleARN = Maybe Text
a} :: RollbackStack)

-- | The name that\'s associated with the stack.
rollbackStack_stackName :: Lens.Lens' RollbackStack Prelude.Text
rollbackStack_stackName :: Lens' RollbackStack Text
rollbackStack_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RollbackStack' {Text
stackName :: Text
$sel:stackName:RollbackStack' :: RollbackStack -> Text
stackName} -> Text
stackName) (\s :: RollbackStack
s@RollbackStack' {} Text
a -> RollbackStack
s {$sel:stackName:RollbackStack' :: Text
stackName = Text
a} :: RollbackStack)

instance Core.AWSRequest RollbackStack where
  type
    AWSResponse RollbackStack =
      RollbackStackResponse
  request :: (Service -> Service) -> RollbackStack -> Request RollbackStack
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RollbackStack
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RollbackStack)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"RollbackStackResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> RollbackStackResponse
RollbackStackResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"StackId")
            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 RollbackStack where
  hashWithSalt :: Int -> RollbackStack -> Int
hashWithSalt Int
_salt RollbackStack' {Maybe Text
Text
stackName :: Text
roleARN :: Maybe Text
clientRequestToken :: Maybe Text
$sel:stackName:RollbackStack' :: RollbackStack -> Text
$sel:roleARN:RollbackStack' :: RollbackStack -> Maybe Text
$sel:clientRequestToken:RollbackStack' :: RollbackStack -> 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 Text
roleARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName

instance Prelude.NFData RollbackStack where
  rnf :: RollbackStack -> ()
rnf RollbackStack' {Maybe Text
Text
stackName :: Text
roleARN :: Maybe Text
clientRequestToken :: Maybe Text
$sel:stackName:RollbackStack' :: RollbackStack -> Text
$sel:roleARN:RollbackStack' :: RollbackStack -> Maybe Text
$sel:clientRequestToken:RollbackStack' :: RollbackStack -> 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 Text
roleARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackName

instance Data.ToHeaders RollbackStack where
  toHeaders :: RollbackStack -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery RollbackStack where
  toQuery :: RollbackStack -> QueryString
toQuery RollbackStack' {Maybe Text
Text
stackName :: Text
roleARN :: Maybe Text
clientRequestToken :: Maybe Text
$sel:stackName:RollbackStack' :: RollbackStack -> Text
$sel:roleARN:RollbackStack' :: RollbackStack -> Maybe Text
$sel:clientRequestToken:RollbackStack' :: RollbackStack -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RollbackStack" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"ClientRequestToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientRequestToken,
        ByteString
"RoleARN" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
roleARN,
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackName
      ]

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

-- |
-- Create a value of 'RollbackStackResponse' 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:
--
-- 'stackId', 'rollbackStackResponse_stackId' - Unique identifier of the stack.
--
-- 'httpStatus', 'rollbackStackResponse_httpStatus' - The response's http status code.
newRollbackStackResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RollbackStackResponse
newRollbackStackResponse :: Int -> RollbackStackResponse
newRollbackStackResponse Int
pHttpStatus_ =
  RollbackStackResponse'
    { $sel:stackId:RollbackStackResponse' :: Maybe Text
stackId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RollbackStackResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Unique identifier of the stack.
rollbackStackResponse_stackId :: Lens.Lens' RollbackStackResponse (Prelude.Maybe Prelude.Text)
rollbackStackResponse_stackId :: Lens' RollbackStackResponse (Maybe Text)
rollbackStackResponse_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RollbackStackResponse' {Maybe Text
stackId :: Maybe Text
$sel:stackId:RollbackStackResponse' :: RollbackStackResponse -> Maybe Text
stackId} -> Maybe Text
stackId) (\s :: RollbackStackResponse
s@RollbackStackResponse' {} Maybe Text
a -> RollbackStackResponse
s {$sel:stackId:RollbackStackResponse' :: Maybe Text
stackId = Maybe Text
a} :: RollbackStackResponse)

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

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