{-# 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.StartInstanceRefresh
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a new instance refresh operation. An instance refresh performs a
-- rolling replacement of all or some instances in an Auto Scaling group.
-- Each instance is terminated first and then replaced, which temporarily
-- reduces the capacity available within your Auto Scaling group.
--
-- This operation is part of the
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/asg-instance-refresh.html instance refresh feature>
-- in Amazon EC2 Auto Scaling, which helps you update instances in your
-- Auto Scaling group. This feature is helpful, for example, when you have
-- a new AMI or a new user data script. You just need to create a new
-- launch template that specifies the new AMI or user data script. Then
-- start an instance refresh to immediately begin the process of updating
-- instances in the group.
--
-- If the call succeeds, it creates a new instance refresh request with a
-- unique ID that you can use to track its progress. To query its status,
-- call the DescribeInstanceRefreshes API. To describe the instance
-- refreshes that have already run, call the DescribeInstanceRefreshes API.
-- To cancel an instance refresh operation in progress, use the
-- CancelInstanceRefresh API.
module Amazonka.AutoScaling.StartInstanceRefresh
  ( -- * Creating a Request
    StartInstanceRefresh (..),
    newStartInstanceRefresh,

    -- * Request Lenses
    startInstanceRefresh_desiredConfiguration,
    startInstanceRefresh_preferences,
    startInstanceRefresh_strategy,
    startInstanceRefresh_autoScalingGroupName,

    -- * Destructuring the Response
    StartInstanceRefreshResponse (..),
    newStartInstanceRefreshResponse,

    -- * Response Lenses
    startInstanceRefreshResponse_instanceRefreshId,
    startInstanceRefreshResponse_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:/ 'newStartInstanceRefresh' smart constructor.
data StartInstanceRefresh = StartInstanceRefresh'
  { -- | The desired configuration. For example, the desired configuration can
    -- specify a new launch template or a new version of the current launch
    -- template.
    --
    -- Once the instance refresh succeeds, Amazon EC2 Auto Scaling updates the
    -- settings of the Auto Scaling group to reflect the new desired
    -- configuration.
    --
    -- When you specify a new launch template or a new version of the current
    -- launch template for your desired configuration, consider enabling the
    -- @SkipMatching@ property in preferences. If it\'s enabled, Amazon EC2
    -- Auto Scaling skips replacing instances that already use the specified
    -- launch template and version. This can help you reduce the number of
    -- replacements that are required to apply updates.
    StartInstanceRefresh -> Maybe DesiredConfiguration
desiredConfiguration :: Prelude.Maybe DesiredConfiguration,
    -- | Set of preferences associated with the instance refresh request. If not
    -- provided, the default values are used.
    StartInstanceRefresh -> Maybe RefreshPreferences
preferences :: Prelude.Maybe RefreshPreferences,
    -- | The strategy to use for the instance refresh. The only valid value is
    -- @Rolling@.
    --
    -- A rolling update helps you update your instances gradually. A rolling
    -- update can fail due to failed health checks or if instances are on
    -- standby or are protected from scale in. If the rolling update process
    -- fails, any instances that are replaced are not rolled back to their
    -- previous configuration.
    StartInstanceRefresh -> Maybe RefreshStrategy
strategy :: Prelude.Maybe RefreshStrategy,
    -- | The name of the Auto Scaling group.
    StartInstanceRefresh -> Text
autoScalingGroupName :: Prelude.Text
  }
  deriving (StartInstanceRefresh -> StartInstanceRefresh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartInstanceRefresh -> StartInstanceRefresh -> Bool
$c/= :: StartInstanceRefresh -> StartInstanceRefresh -> Bool
== :: StartInstanceRefresh -> StartInstanceRefresh -> Bool
$c== :: StartInstanceRefresh -> StartInstanceRefresh -> Bool
Prelude.Eq, ReadPrec [StartInstanceRefresh]
ReadPrec StartInstanceRefresh
Int -> ReadS StartInstanceRefresh
ReadS [StartInstanceRefresh]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartInstanceRefresh]
$creadListPrec :: ReadPrec [StartInstanceRefresh]
readPrec :: ReadPrec StartInstanceRefresh
$creadPrec :: ReadPrec StartInstanceRefresh
readList :: ReadS [StartInstanceRefresh]
$creadList :: ReadS [StartInstanceRefresh]
readsPrec :: Int -> ReadS StartInstanceRefresh
$creadsPrec :: Int -> ReadS StartInstanceRefresh
Prelude.Read, Int -> StartInstanceRefresh -> ShowS
[StartInstanceRefresh] -> ShowS
StartInstanceRefresh -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartInstanceRefresh] -> ShowS
$cshowList :: [StartInstanceRefresh] -> ShowS
show :: StartInstanceRefresh -> String
$cshow :: StartInstanceRefresh -> String
showsPrec :: Int -> StartInstanceRefresh -> ShowS
$cshowsPrec :: Int -> StartInstanceRefresh -> ShowS
Prelude.Show, forall x. Rep StartInstanceRefresh x -> StartInstanceRefresh
forall x. StartInstanceRefresh -> Rep StartInstanceRefresh x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartInstanceRefresh x -> StartInstanceRefresh
$cfrom :: forall x. StartInstanceRefresh -> Rep StartInstanceRefresh x
Prelude.Generic)

-- |
-- Create a value of 'StartInstanceRefresh' 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:
--
-- 'desiredConfiguration', 'startInstanceRefresh_desiredConfiguration' - The desired configuration. For example, the desired configuration can
-- specify a new launch template or a new version of the current launch
-- template.
--
-- Once the instance refresh succeeds, Amazon EC2 Auto Scaling updates the
-- settings of the Auto Scaling group to reflect the new desired
-- configuration.
--
-- When you specify a new launch template or a new version of the current
-- launch template for your desired configuration, consider enabling the
-- @SkipMatching@ property in preferences. If it\'s enabled, Amazon EC2
-- Auto Scaling skips replacing instances that already use the specified
-- launch template and version. This can help you reduce the number of
-- replacements that are required to apply updates.
--
-- 'preferences', 'startInstanceRefresh_preferences' - Set of preferences associated with the instance refresh request. If not
-- provided, the default values are used.
--
-- 'strategy', 'startInstanceRefresh_strategy' - The strategy to use for the instance refresh. The only valid value is
-- @Rolling@.
--
-- A rolling update helps you update your instances gradually. A rolling
-- update can fail due to failed health checks or if instances are on
-- standby or are protected from scale in. If the rolling update process
-- fails, any instances that are replaced are not rolled back to their
-- previous configuration.
--
-- 'autoScalingGroupName', 'startInstanceRefresh_autoScalingGroupName' - The name of the Auto Scaling group.
newStartInstanceRefresh ::
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  StartInstanceRefresh
newStartInstanceRefresh :: Text -> StartInstanceRefresh
newStartInstanceRefresh Text
pAutoScalingGroupName_ =
  StartInstanceRefresh'
    { $sel:desiredConfiguration:StartInstanceRefresh' :: Maybe DesiredConfiguration
desiredConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:preferences:StartInstanceRefresh' :: Maybe RefreshPreferences
preferences = forall a. Maybe a
Prelude.Nothing,
      $sel:strategy:StartInstanceRefresh' :: Maybe RefreshStrategy
strategy = forall a. Maybe a
Prelude.Nothing,
      $sel:autoScalingGroupName:StartInstanceRefresh' :: Text
autoScalingGroupName = Text
pAutoScalingGroupName_
    }

-- | The desired configuration. For example, the desired configuration can
-- specify a new launch template or a new version of the current launch
-- template.
--
-- Once the instance refresh succeeds, Amazon EC2 Auto Scaling updates the
-- settings of the Auto Scaling group to reflect the new desired
-- configuration.
--
-- When you specify a new launch template or a new version of the current
-- launch template for your desired configuration, consider enabling the
-- @SkipMatching@ property in preferences. If it\'s enabled, Amazon EC2
-- Auto Scaling skips replacing instances that already use the specified
-- launch template and version. This can help you reduce the number of
-- replacements that are required to apply updates.
startInstanceRefresh_desiredConfiguration :: Lens.Lens' StartInstanceRefresh (Prelude.Maybe DesiredConfiguration)
startInstanceRefresh_desiredConfiguration :: Lens' StartInstanceRefresh (Maybe DesiredConfiguration)
startInstanceRefresh_desiredConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartInstanceRefresh' {Maybe DesiredConfiguration
desiredConfiguration :: Maybe DesiredConfiguration
$sel:desiredConfiguration:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe DesiredConfiguration
desiredConfiguration} -> Maybe DesiredConfiguration
desiredConfiguration) (\s :: StartInstanceRefresh
s@StartInstanceRefresh' {} Maybe DesiredConfiguration
a -> StartInstanceRefresh
s {$sel:desiredConfiguration:StartInstanceRefresh' :: Maybe DesiredConfiguration
desiredConfiguration = Maybe DesiredConfiguration
a} :: StartInstanceRefresh)

-- | Set of preferences associated with the instance refresh request. If not
-- provided, the default values are used.
startInstanceRefresh_preferences :: Lens.Lens' StartInstanceRefresh (Prelude.Maybe RefreshPreferences)
startInstanceRefresh_preferences :: Lens' StartInstanceRefresh (Maybe RefreshPreferences)
startInstanceRefresh_preferences = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartInstanceRefresh' {Maybe RefreshPreferences
preferences :: Maybe RefreshPreferences
$sel:preferences:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshPreferences
preferences} -> Maybe RefreshPreferences
preferences) (\s :: StartInstanceRefresh
s@StartInstanceRefresh' {} Maybe RefreshPreferences
a -> StartInstanceRefresh
s {$sel:preferences:StartInstanceRefresh' :: Maybe RefreshPreferences
preferences = Maybe RefreshPreferences
a} :: StartInstanceRefresh)

-- | The strategy to use for the instance refresh. The only valid value is
-- @Rolling@.
--
-- A rolling update helps you update your instances gradually. A rolling
-- update can fail due to failed health checks or if instances are on
-- standby or are protected from scale in. If the rolling update process
-- fails, any instances that are replaced are not rolled back to their
-- previous configuration.
startInstanceRefresh_strategy :: Lens.Lens' StartInstanceRefresh (Prelude.Maybe RefreshStrategy)
startInstanceRefresh_strategy :: Lens' StartInstanceRefresh (Maybe RefreshStrategy)
startInstanceRefresh_strategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartInstanceRefresh' {Maybe RefreshStrategy
strategy :: Maybe RefreshStrategy
$sel:strategy:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshStrategy
strategy} -> Maybe RefreshStrategy
strategy) (\s :: StartInstanceRefresh
s@StartInstanceRefresh' {} Maybe RefreshStrategy
a -> StartInstanceRefresh
s {$sel:strategy:StartInstanceRefresh' :: Maybe RefreshStrategy
strategy = Maybe RefreshStrategy
a} :: StartInstanceRefresh)

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

instance Core.AWSRequest StartInstanceRefresh where
  type
    AWSResponse StartInstanceRefresh =
      StartInstanceRefreshResponse
  request :: (Service -> Service)
-> StartInstanceRefresh -> Request StartInstanceRefresh
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 StartInstanceRefresh
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartInstanceRefresh)))
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
"StartInstanceRefreshResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> StartInstanceRefreshResponse
StartInstanceRefreshResponse'
            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
"InstanceRefreshId")
            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 StartInstanceRefresh where
  hashWithSalt :: Int -> StartInstanceRefresh -> Int
hashWithSalt Int
_salt StartInstanceRefresh' {Maybe RefreshPreferences
Maybe RefreshStrategy
Maybe DesiredConfiguration
Text
autoScalingGroupName :: Text
strategy :: Maybe RefreshStrategy
preferences :: Maybe RefreshPreferences
desiredConfiguration :: Maybe DesiredConfiguration
$sel:autoScalingGroupName:StartInstanceRefresh' :: StartInstanceRefresh -> Text
$sel:strategy:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshStrategy
$sel:preferences:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshPreferences
$sel:desiredConfiguration:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe DesiredConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DesiredConfiguration
desiredConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RefreshPreferences
preferences
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RefreshStrategy
strategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName

instance Prelude.NFData StartInstanceRefresh where
  rnf :: StartInstanceRefresh -> ()
rnf StartInstanceRefresh' {Maybe RefreshPreferences
Maybe RefreshStrategy
Maybe DesiredConfiguration
Text
autoScalingGroupName :: Text
strategy :: Maybe RefreshStrategy
preferences :: Maybe RefreshPreferences
desiredConfiguration :: Maybe DesiredConfiguration
$sel:autoScalingGroupName:StartInstanceRefresh' :: StartInstanceRefresh -> Text
$sel:strategy:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshStrategy
$sel:preferences:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshPreferences
$sel:desiredConfiguration:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe DesiredConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DesiredConfiguration
desiredConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RefreshPreferences
preferences
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RefreshStrategy
strategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName

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

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

instance Data.ToQuery StartInstanceRefresh where
  toQuery :: StartInstanceRefresh -> QueryString
toQuery StartInstanceRefresh' {Maybe RefreshPreferences
Maybe RefreshStrategy
Maybe DesiredConfiguration
Text
autoScalingGroupName :: Text
strategy :: Maybe RefreshStrategy
preferences :: Maybe RefreshPreferences
desiredConfiguration :: Maybe DesiredConfiguration
$sel:autoScalingGroupName:StartInstanceRefresh' :: StartInstanceRefresh -> Text
$sel:strategy:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshStrategy
$sel:preferences:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe RefreshPreferences
$sel:desiredConfiguration:StartInstanceRefresh' :: StartInstanceRefresh -> Maybe DesiredConfiguration
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"StartInstanceRefresh" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"DesiredConfiguration" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DesiredConfiguration
desiredConfiguration,
        ByteString
"Preferences" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe RefreshPreferences
preferences,
        ByteString
"Strategy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe RefreshStrategy
strategy,
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName
      ]

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

-- |
-- Create a value of 'StartInstanceRefreshResponse' 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:
--
-- 'instanceRefreshId', 'startInstanceRefreshResponse_instanceRefreshId' - A unique ID for tracking the progress of the request.
--
-- 'httpStatus', 'startInstanceRefreshResponse_httpStatus' - The response's http status code.
newStartInstanceRefreshResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartInstanceRefreshResponse
newStartInstanceRefreshResponse :: Int -> StartInstanceRefreshResponse
newStartInstanceRefreshResponse Int
pHttpStatus_ =
  StartInstanceRefreshResponse'
    { $sel:instanceRefreshId:StartInstanceRefreshResponse' :: Maybe Text
instanceRefreshId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartInstanceRefreshResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique ID for tracking the progress of the request.
startInstanceRefreshResponse_instanceRefreshId :: Lens.Lens' StartInstanceRefreshResponse (Prelude.Maybe Prelude.Text)
startInstanceRefreshResponse_instanceRefreshId :: Lens' StartInstanceRefreshResponse (Maybe Text)
startInstanceRefreshResponse_instanceRefreshId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartInstanceRefreshResponse' {Maybe Text
instanceRefreshId :: Maybe Text
$sel:instanceRefreshId:StartInstanceRefreshResponse' :: StartInstanceRefreshResponse -> Maybe Text
instanceRefreshId} -> Maybe Text
instanceRefreshId) (\s :: StartInstanceRefreshResponse
s@StartInstanceRefreshResponse' {} Maybe Text
a -> StartInstanceRefreshResponse
s {$sel:instanceRefreshId:StartInstanceRefreshResponse' :: Maybe Text
instanceRefreshId = Maybe Text
a} :: StartInstanceRefreshResponse)

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

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