{-# 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.AutoScaling.CompleteLifecycleAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Completes the lifecycle action for the specified token or instance with
-- the specified result.
--
-- This step is a part of the procedure for adding a lifecycle hook to an
-- Auto Scaling group:
--
-- 1.  (Optional) Create a launch template or launch configuration with a
--     user data script that runs while an instance is in a wait state due
--     to a lifecycle hook.
--
-- 2.  (Optional) Create a Lambda function and a rule that allows Amazon
--     EventBridge to invoke your Lambda function when an instance is put
--     into a wait state due to a lifecycle hook.
--
-- 3.  (Optional) Create a notification target and an IAM role. The target
--     can be either an Amazon SQS queue or an Amazon SNS topic. The role
--     allows Amazon EC2 Auto Scaling to publish lifecycle notifications to
--     the target.
--
-- 4.  Create the lifecycle hook. Specify whether the hook is used when the
--     instances launch or terminate.
--
-- 5.  If you need more time, record the lifecycle action heartbeat to keep
--     the instance in a wait state.
--
-- 6.  __If you finish before the timeout period ends, send a callback by
--     using the CompleteLifecycleAction API call.__
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/lifecycle-hooks.html Amazon EC2 Auto Scaling lifecycle hooks>
-- in the /Amazon EC2 Auto Scaling User Guide/.
module Amazonka.AutoScaling.CompleteLifecycleAction
  ( -- * Creating a Request
    CompleteLifecycleAction (..),
    newCompleteLifecycleAction,

    -- * Request Lenses
    completeLifecycleAction_instanceId,
    completeLifecycleAction_lifecycleActionToken,
    completeLifecycleAction_lifecycleHookName,
    completeLifecycleAction_autoScalingGroupName,
    completeLifecycleAction_lifecycleActionResult,

    -- * Destructuring the Response
    CompleteLifecycleActionResponse (..),
    newCompleteLifecycleActionResponse,

    -- * Response Lenses
    completeLifecycleActionResponse_httpStatus,
  )
where

import Amazonka.AutoScaling.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:/ 'newCompleteLifecycleAction' smart constructor.
data CompleteLifecycleAction = CompleteLifecycleAction'
  { -- | The ID of the instance.
    CompleteLifecycleAction -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | A universally unique identifier (UUID) that identifies a specific
    -- lifecycle action associated with an instance. Amazon EC2 Auto Scaling
    -- sends this token to the notification target you specified when you
    -- created the lifecycle hook.
    CompleteLifecycleAction -> Maybe Text
lifecycleActionToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the lifecycle hook.
    CompleteLifecycleAction -> Text
lifecycleHookName :: Prelude.Text,
    -- | The name of the Auto Scaling group.
    CompleteLifecycleAction -> Text
autoScalingGroupName :: Prelude.Text,
    -- | The action for the group to take. You can specify either @CONTINUE@ or
    -- @ABANDON@.
    CompleteLifecycleAction -> Text
lifecycleActionResult :: Prelude.Text
  }
  deriving (CompleteLifecycleAction -> CompleteLifecycleAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteLifecycleAction -> CompleteLifecycleAction -> Bool
$c/= :: CompleteLifecycleAction -> CompleteLifecycleAction -> Bool
== :: CompleteLifecycleAction -> CompleteLifecycleAction -> Bool
$c== :: CompleteLifecycleAction -> CompleteLifecycleAction -> Bool
Prelude.Eq, ReadPrec [CompleteLifecycleAction]
ReadPrec CompleteLifecycleAction
Int -> ReadS CompleteLifecycleAction
ReadS [CompleteLifecycleAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompleteLifecycleAction]
$creadListPrec :: ReadPrec [CompleteLifecycleAction]
readPrec :: ReadPrec CompleteLifecycleAction
$creadPrec :: ReadPrec CompleteLifecycleAction
readList :: ReadS [CompleteLifecycleAction]
$creadList :: ReadS [CompleteLifecycleAction]
readsPrec :: Int -> ReadS CompleteLifecycleAction
$creadsPrec :: Int -> ReadS CompleteLifecycleAction
Prelude.Read, Int -> CompleteLifecycleAction -> ShowS
[CompleteLifecycleAction] -> ShowS
CompleteLifecycleAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteLifecycleAction] -> ShowS
$cshowList :: [CompleteLifecycleAction] -> ShowS
show :: CompleteLifecycleAction -> String
$cshow :: CompleteLifecycleAction -> String
showsPrec :: Int -> CompleteLifecycleAction -> ShowS
$cshowsPrec :: Int -> CompleteLifecycleAction -> ShowS
Prelude.Show, forall x. Rep CompleteLifecycleAction x -> CompleteLifecycleAction
forall x. CompleteLifecycleAction -> Rep CompleteLifecycleAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompleteLifecycleAction x -> CompleteLifecycleAction
$cfrom :: forall x. CompleteLifecycleAction -> Rep CompleteLifecycleAction x
Prelude.Generic)

-- |
-- Create a value of 'CompleteLifecycleAction' 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:
--
-- 'instanceId', 'completeLifecycleAction_instanceId' - The ID of the instance.
--
-- 'lifecycleActionToken', 'completeLifecycleAction_lifecycleActionToken' - A universally unique identifier (UUID) that identifies a specific
-- lifecycle action associated with an instance. Amazon EC2 Auto Scaling
-- sends this token to the notification target you specified when you
-- created the lifecycle hook.
--
-- 'lifecycleHookName', 'completeLifecycleAction_lifecycleHookName' - The name of the lifecycle hook.
--
-- 'autoScalingGroupName', 'completeLifecycleAction_autoScalingGroupName' - The name of the Auto Scaling group.
--
-- 'lifecycleActionResult', 'completeLifecycleAction_lifecycleActionResult' - The action for the group to take. You can specify either @CONTINUE@ or
-- @ABANDON@.
newCompleteLifecycleAction ::
  -- | 'lifecycleHookName'
  Prelude.Text ->
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  -- | 'lifecycleActionResult'
  Prelude.Text ->
  CompleteLifecycleAction
newCompleteLifecycleAction :: Text -> Text -> Text -> CompleteLifecycleAction
newCompleteLifecycleAction
  Text
pLifecycleHookName_
  Text
pAutoScalingGroupName_
  Text
pLifecycleActionResult_ =
    CompleteLifecycleAction'
      { $sel:instanceId:CompleteLifecycleAction' :: Maybe Text
instanceId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:lifecycleActionToken:CompleteLifecycleAction' :: Maybe Text
lifecycleActionToken = forall a. Maybe a
Prelude.Nothing,
        $sel:lifecycleHookName:CompleteLifecycleAction' :: Text
lifecycleHookName = Text
pLifecycleHookName_,
        $sel:autoScalingGroupName:CompleteLifecycleAction' :: Text
autoScalingGroupName = Text
pAutoScalingGroupName_,
        $sel:lifecycleActionResult:CompleteLifecycleAction' :: Text
lifecycleActionResult = Text
pLifecycleActionResult_
      }

-- | The ID of the instance.
completeLifecycleAction_instanceId :: Lens.Lens' CompleteLifecycleAction (Prelude.Maybe Prelude.Text)
completeLifecycleAction_instanceId :: Lens' CompleteLifecycleAction (Maybe Text)
completeLifecycleAction_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteLifecycleAction' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: CompleteLifecycleAction
s@CompleteLifecycleAction' {} Maybe Text
a -> CompleteLifecycleAction
s {$sel:instanceId:CompleteLifecycleAction' :: Maybe Text
instanceId = Maybe Text
a} :: CompleteLifecycleAction)

-- | A universally unique identifier (UUID) that identifies a specific
-- lifecycle action associated with an instance. Amazon EC2 Auto Scaling
-- sends this token to the notification target you specified when you
-- created the lifecycle hook.
completeLifecycleAction_lifecycleActionToken :: Lens.Lens' CompleteLifecycleAction (Prelude.Maybe Prelude.Text)
completeLifecycleAction_lifecycleActionToken :: Lens' CompleteLifecycleAction (Maybe Text)
completeLifecycleAction_lifecycleActionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteLifecycleAction' {Maybe Text
lifecycleActionToken :: Maybe Text
$sel:lifecycleActionToken:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
lifecycleActionToken} -> Maybe Text
lifecycleActionToken) (\s :: CompleteLifecycleAction
s@CompleteLifecycleAction' {} Maybe Text
a -> CompleteLifecycleAction
s {$sel:lifecycleActionToken:CompleteLifecycleAction' :: Maybe Text
lifecycleActionToken = Maybe Text
a} :: CompleteLifecycleAction)

-- | The name of the lifecycle hook.
completeLifecycleAction_lifecycleHookName :: Lens.Lens' CompleteLifecycleAction Prelude.Text
completeLifecycleAction_lifecycleHookName :: Lens' CompleteLifecycleAction Text
completeLifecycleAction_lifecycleHookName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteLifecycleAction' {Text
lifecycleHookName :: Text
$sel:lifecycleHookName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
lifecycleHookName} -> Text
lifecycleHookName) (\s :: CompleteLifecycleAction
s@CompleteLifecycleAction' {} Text
a -> CompleteLifecycleAction
s {$sel:lifecycleHookName:CompleteLifecycleAction' :: Text
lifecycleHookName = Text
a} :: CompleteLifecycleAction)

-- | The name of the Auto Scaling group.
completeLifecycleAction_autoScalingGroupName :: Lens.Lens' CompleteLifecycleAction Prelude.Text
completeLifecycleAction_autoScalingGroupName :: Lens' CompleteLifecycleAction Text
completeLifecycleAction_autoScalingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteLifecycleAction' {Text
autoScalingGroupName :: Text
$sel:autoScalingGroupName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
autoScalingGroupName} -> Text
autoScalingGroupName) (\s :: CompleteLifecycleAction
s@CompleteLifecycleAction' {} Text
a -> CompleteLifecycleAction
s {$sel:autoScalingGroupName:CompleteLifecycleAction' :: Text
autoScalingGroupName = Text
a} :: CompleteLifecycleAction)

-- | The action for the group to take. You can specify either @CONTINUE@ or
-- @ABANDON@.
completeLifecycleAction_lifecycleActionResult :: Lens.Lens' CompleteLifecycleAction Prelude.Text
completeLifecycleAction_lifecycleActionResult :: Lens' CompleteLifecycleAction Text
completeLifecycleAction_lifecycleActionResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteLifecycleAction' {Text
lifecycleActionResult :: Text
$sel:lifecycleActionResult:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
lifecycleActionResult} -> Text
lifecycleActionResult) (\s :: CompleteLifecycleAction
s@CompleteLifecycleAction' {} Text
a -> CompleteLifecycleAction
s {$sel:lifecycleActionResult:CompleteLifecycleAction' :: Text
lifecycleActionResult = Text
a} :: CompleteLifecycleAction)

instance Core.AWSRequest CompleteLifecycleAction where
  type
    AWSResponse CompleteLifecycleAction =
      CompleteLifecycleActionResponse
  request :: (Service -> Service)
-> CompleteLifecycleAction -> Request CompleteLifecycleAction
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 CompleteLifecycleAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CompleteLifecycleAction)))
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
"CompleteLifecycleActionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> CompleteLifecycleActionResponse
CompleteLifecycleActionResponse'
            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))
      )

instance Prelude.Hashable CompleteLifecycleAction where
  hashWithSalt :: Int -> CompleteLifecycleAction -> Int
hashWithSalt Int
_salt CompleteLifecycleAction' {Maybe Text
Text
lifecycleActionResult :: Text
autoScalingGroupName :: Text
lifecycleHookName :: Text
lifecycleActionToken :: Maybe Text
instanceId :: Maybe Text
$sel:lifecycleActionResult:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:autoScalingGroupName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:lifecycleHookName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:lifecycleActionToken:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
$sel:instanceId:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lifecycleActionToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lifecycleHookName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lifecycleActionResult

instance Prelude.NFData CompleteLifecycleAction where
  rnf :: CompleteLifecycleAction -> ()
rnf CompleteLifecycleAction' {Maybe Text
Text
lifecycleActionResult :: Text
autoScalingGroupName :: Text
lifecycleHookName :: Text
lifecycleActionToken :: Maybe Text
instanceId :: Maybe Text
$sel:lifecycleActionResult:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:autoScalingGroupName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:lifecycleHookName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:lifecycleActionToken:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
$sel:instanceId:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lifecycleActionToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lifecycleHookName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lifecycleActionResult

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

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

instance Data.ToQuery CompleteLifecycleAction where
  toQuery :: CompleteLifecycleAction -> QueryString
toQuery CompleteLifecycleAction' {Maybe Text
Text
lifecycleActionResult :: Text
autoScalingGroupName :: Text
lifecycleHookName :: Text
lifecycleActionToken :: Maybe Text
instanceId :: Maybe Text
$sel:lifecycleActionResult:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:autoScalingGroupName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:lifecycleHookName:CompleteLifecycleAction' :: CompleteLifecycleAction -> Text
$sel:lifecycleActionToken:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
$sel:instanceId:CompleteLifecycleAction' :: CompleteLifecycleAction -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CompleteLifecycleAction" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
instanceId,
        ByteString
"LifecycleActionToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
lifecycleActionToken,
        ByteString
"LifecycleHookName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
lifecycleHookName,
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName,
        ByteString
"LifecycleActionResult"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
lifecycleActionResult
      ]

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

-- |
-- Create a value of 'CompleteLifecycleActionResponse' 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', 'completeLifecycleActionResponse_httpStatus' - The response's http status code.
newCompleteLifecycleActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CompleteLifecycleActionResponse
newCompleteLifecycleActionResponse :: Int -> CompleteLifecycleActionResponse
newCompleteLifecycleActionResponse Int
pHttpStatus_ =
  CompleteLifecycleActionResponse'
    { $sel:httpStatus:CompleteLifecycleActionResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    CompleteLifecycleActionResponse
  where
  rnf :: CompleteLifecycleActionResponse -> ()
rnf CompleteLifecycleActionResponse' {Int
httpStatus :: Int
$sel:httpStatus:CompleteLifecycleActionResponse' :: CompleteLifecycleActionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus