{-# 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.RecordLifecycleActionHeartbeat
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Records a heartbeat for the lifecycle action associated with the
-- specified token or instance. This extends the timeout by the length of
-- time defined using the PutLifecycleHook API call.
--
-- 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.RecordLifecycleActionHeartbeat
  ( -- * Creating a Request
    RecordLifecycleActionHeartbeat (..),
    newRecordLifecycleActionHeartbeat,

    -- * Request Lenses
    recordLifecycleActionHeartbeat_instanceId,
    recordLifecycleActionHeartbeat_lifecycleActionToken,
    recordLifecycleActionHeartbeat_lifecycleHookName,
    recordLifecycleActionHeartbeat_autoScalingGroupName,

    -- * Destructuring the Response
    RecordLifecycleActionHeartbeatResponse (..),
    newRecordLifecycleActionHeartbeatResponse,

    -- * Response Lenses
    recordLifecycleActionHeartbeatResponse_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:/ 'newRecordLifecycleActionHeartbeat' smart constructor.
data RecordLifecycleActionHeartbeat = RecordLifecycleActionHeartbeat'
  { -- | The ID of the instance.
    RecordLifecycleActionHeartbeat -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | A token that uniquely identifies a specific lifecycle action associated
    -- with an instance. Amazon EC2 Auto Scaling sends this token to the
    -- notification target that you specified when you created the lifecycle
    -- hook.
    RecordLifecycleActionHeartbeat -> Maybe Text
lifecycleActionToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the lifecycle hook.
    RecordLifecycleActionHeartbeat -> Text
lifecycleHookName :: Prelude.Text,
    -- | The name of the Auto Scaling group.
    RecordLifecycleActionHeartbeat -> Text
autoScalingGroupName :: Prelude.Text
  }
  deriving (RecordLifecycleActionHeartbeat
-> RecordLifecycleActionHeartbeat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordLifecycleActionHeartbeat
-> RecordLifecycleActionHeartbeat -> Bool
$c/= :: RecordLifecycleActionHeartbeat
-> RecordLifecycleActionHeartbeat -> Bool
== :: RecordLifecycleActionHeartbeat
-> RecordLifecycleActionHeartbeat -> Bool
$c== :: RecordLifecycleActionHeartbeat
-> RecordLifecycleActionHeartbeat -> Bool
Prelude.Eq, ReadPrec [RecordLifecycleActionHeartbeat]
ReadPrec RecordLifecycleActionHeartbeat
Int -> ReadS RecordLifecycleActionHeartbeat
ReadS [RecordLifecycleActionHeartbeat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecordLifecycleActionHeartbeat]
$creadListPrec :: ReadPrec [RecordLifecycleActionHeartbeat]
readPrec :: ReadPrec RecordLifecycleActionHeartbeat
$creadPrec :: ReadPrec RecordLifecycleActionHeartbeat
readList :: ReadS [RecordLifecycleActionHeartbeat]
$creadList :: ReadS [RecordLifecycleActionHeartbeat]
readsPrec :: Int -> ReadS RecordLifecycleActionHeartbeat
$creadsPrec :: Int -> ReadS RecordLifecycleActionHeartbeat
Prelude.Read, Int -> RecordLifecycleActionHeartbeat -> ShowS
[RecordLifecycleActionHeartbeat] -> ShowS
RecordLifecycleActionHeartbeat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordLifecycleActionHeartbeat] -> ShowS
$cshowList :: [RecordLifecycleActionHeartbeat] -> ShowS
show :: RecordLifecycleActionHeartbeat -> String
$cshow :: RecordLifecycleActionHeartbeat -> String
showsPrec :: Int -> RecordLifecycleActionHeartbeat -> ShowS
$cshowsPrec :: Int -> RecordLifecycleActionHeartbeat -> ShowS
Prelude.Show, forall x.
Rep RecordLifecycleActionHeartbeat x
-> RecordLifecycleActionHeartbeat
forall x.
RecordLifecycleActionHeartbeat
-> Rep RecordLifecycleActionHeartbeat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RecordLifecycleActionHeartbeat x
-> RecordLifecycleActionHeartbeat
$cfrom :: forall x.
RecordLifecycleActionHeartbeat
-> Rep RecordLifecycleActionHeartbeat x
Prelude.Generic)

-- |
-- Create a value of 'RecordLifecycleActionHeartbeat' 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', 'recordLifecycleActionHeartbeat_instanceId' - The ID of the instance.
--
-- 'lifecycleActionToken', 'recordLifecycleActionHeartbeat_lifecycleActionToken' - A token that uniquely identifies a specific lifecycle action associated
-- with an instance. Amazon EC2 Auto Scaling sends this token to the
-- notification target that you specified when you created the lifecycle
-- hook.
--
-- 'lifecycleHookName', 'recordLifecycleActionHeartbeat_lifecycleHookName' - The name of the lifecycle hook.
--
-- 'autoScalingGroupName', 'recordLifecycleActionHeartbeat_autoScalingGroupName' - The name of the Auto Scaling group.
newRecordLifecycleActionHeartbeat ::
  -- | 'lifecycleHookName'
  Prelude.Text ->
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  RecordLifecycleActionHeartbeat
newRecordLifecycleActionHeartbeat :: Text -> Text -> RecordLifecycleActionHeartbeat
newRecordLifecycleActionHeartbeat
  Text
pLifecycleHookName_
  Text
pAutoScalingGroupName_ =
    RecordLifecycleActionHeartbeat'
      { $sel:instanceId:RecordLifecycleActionHeartbeat' :: Maybe Text
instanceId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:lifecycleActionToken:RecordLifecycleActionHeartbeat' :: Maybe Text
lifecycleActionToken = forall a. Maybe a
Prelude.Nothing,
        $sel:lifecycleHookName:RecordLifecycleActionHeartbeat' :: Text
lifecycleHookName = Text
pLifecycleHookName_,
        $sel:autoScalingGroupName:RecordLifecycleActionHeartbeat' :: Text
autoScalingGroupName =
          Text
pAutoScalingGroupName_
      }

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

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

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

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

instance
  Core.AWSRequest
    RecordLifecycleActionHeartbeat
  where
  type
    AWSResponse RecordLifecycleActionHeartbeat =
      RecordLifecycleActionHeartbeatResponse
  request :: (Service -> Service)
-> RecordLifecycleActionHeartbeat
-> Request RecordLifecycleActionHeartbeat
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 RecordLifecycleActionHeartbeat
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse RecordLifecycleActionHeartbeat)))
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
"RecordLifecycleActionHeartbeatResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> RecordLifecycleActionHeartbeatResponse
RecordLifecycleActionHeartbeatResponse'
            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
    RecordLifecycleActionHeartbeat
  where
  hashWithSalt :: Int -> RecordLifecycleActionHeartbeat -> Int
hashWithSalt
    Int
_salt
    RecordLifecycleActionHeartbeat' {Maybe Text
Text
autoScalingGroupName :: Text
lifecycleHookName :: Text
lifecycleActionToken :: Maybe Text
instanceId :: Maybe Text
$sel:autoScalingGroupName:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Text
$sel:lifecycleHookName:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Text
$sel:lifecycleActionToken:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Maybe Text
$sel:instanceId:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> 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

instance
  Prelude.NFData
    RecordLifecycleActionHeartbeat
  where
  rnf :: RecordLifecycleActionHeartbeat -> ()
rnf RecordLifecycleActionHeartbeat' {Maybe Text
Text
autoScalingGroupName :: Text
lifecycleHookName :: Text
lifecycleActionToken :: Maybe Text
instanceId :: Maybe Text
$sel:autoScalingGroupName:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Text
$sel:lifecycleHookName:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Text
$sel:lifecycleActionToken:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Maybe Text
$sel:instanceId:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> 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

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

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

instance Data.ToQuery RecordLifecycleActionHeartbeat where
  toQuery :: RecordLifecycleActionHeartbeat -> QueryString
toQuery RecordLifecycleActionHeartbeat' {Maybe Text
Text
autoScalingGroupName :: Text
lifecycleHookName :: Text
lifecycleActionToken :: Maybe Text
instanceId :: Maybe Text
$sel:autoScalingGroupName:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Text
$sel:lifecycleHookName:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Text
$sel:lifecycleActionToken:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Maybe Text
$sel:instanceId:RecordLifecycleActionHeartbeat' :: RecordLifecycleActionHeartbeat -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"RecordLifecycleActionHeartbeat" ::
                      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
      ]

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

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

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

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