{-# 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.Neptune.ApplyPendingMaintenanceAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Applies a pending maintenance action to a resource (for example, to a DB
-- instance).
module Amazonka.Neptune.ApplyPendingMaintenanceAction
  ( -- * Creating a Request
    ApplyPendingMaintenanceAction (..),
    newApplyPendingMaintenanceAction,

    -- * Request Lenses
    applyPendingMaintenanceAction_resourceIdentifier,
    applyPendingMaintenanceAction_applyAction,
    applyPendingMaintenanceAction_optInType,

    -- * Destructuring the Response
    ApplyPendingMaintenanceActionResponse (..),
    newApplyPendingMaintenanceActionResponse,

    -- * Response Lenses
    applyPendingMaintenanceActionResponse_resourcePendingMaintenanceActions,
    applyPendingMaintenanceActionResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Neptune.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newApplyPendingMaintenanceAction' smart constructor.
data ApplyPendingMaintenanceAction = ApplyPendingMaintenanceAction'
  { -- | The Amazon Resource Name (ARN) of the resource that the pending
    -- maintenance action applies to. For information about creating an ARN,
    -- see
    -- <https://docs.aws.amazon.com/neptune/latest/UserGuide/tagging.ARN.html#tagging.ARN.Constructing Constructing an Amazon Resource Name (ARN)>.
    ApplyPendingMaintenanceAction -> Text
resourceIdentifier :: Prelude.Text,
    -- | The pending maintenance action to apply to this resource.
    --
    -- Valid values: @system-update@, @db-upgrade@
    ApplyPendingMaintenanceAction -> Text
applyAction :: Prelude.Text,
    -- | A value that specifies the type of opt-in request, or undoes an opt-in
    -- request. An opt-in request of type @immediate@ can\'t be undone.
    --
    -- Valid values:
    --
    -- -   @immediate@ - Apply the maintenance action immediately.
    --
    -- -   @next-maintenance@ - Apply the maintenance action during the next
    --     maintenance window for the resource.
    --
    -- -   @undo-opt-in@ - Cancel any existing @next-maintenance@ opt-in
    --     requests.
    ApplyPendingMaintenanceAction -> Text
optInType :: Prelude.Text
  }
  deriving (ApplyPendingMaintenanceAction
-> ApplyPendingMaintenanceAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyPendingMaintenanceAction
-> ApplyPendingMaintenanceAction -> Bool
$c/= :: ApplyPendingMaintenanceAction
-> ApplyPendingMaintenanceAction -> Bool
== :: ApplyPendingMaintenanceAction
-> ApplyPendingMaintenanceAction -> Bool
$c== :: ApplyPendingMaintenanceAction
-> ApplyPendingMaintenanceAction -> Bool
Prelude.Eq, ReadPrec [ApplyPendingMaintenanceAction]
ReadPrec ApplyPendingMaintenanceAction
Int -> ReadS ApplyPendingMaintenanceAction
ReadS [ApplyPendingMaintenanceAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplyPendingMaintenanceAction]
$creadListPrec :: ReadPrec [ApplyPendingMaintenanceAction]
readPrec :: ReadPrec ApplyPendingMaintenanceAction
$creadPrec :: ReadPrec ApplyPendingMaintenanceAction
readList :: ReadS [ApplyPendingMaintenanceAction]
$creadList :: ReadS [ApplyPendingMaintenanceAction]
readsPrec :: Int -> ReadS ApplyPendingMaintenanceAction
$creadsPrec :: Int -> ReadS ApplyPendingMaintenanceAction
Prelude.Read, Int -> ApplyPendingMaintenanceAction -> ShowS
[ApplyPendingMaintenanceAction] -> ShowS
ApplyPendingMaintenanceAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyPendingMaintenanceAction] -> ShowS
$cshowList :: [ApplyPendingMaintenanceAction] -> ShowS
show :: ApplyPendingMaintenanceAction -> String
$cshow :: ApplyPendingMaintenanceAction -> String
showsPrec :: Int -> ApplyPendingMaintenanceAction -> ShowS
$cshowsPrec :: Int -> ApplyPendingMaintenanceAction -> ShowS
Prelude.Show, forall x.
Rep ApplyPendingMaintenanceAction x
-> ApplyPendingMaintenanceAction
forall x.
ApplyPendingMaintenanceAction
-> Rep ApplyPendingMaintenanceAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApplyPendingMaintenanceAction x
-> ApplyPendingMaintenanceAction
$cfrom :: forall x.
ApplyPendingMaintenanceAction
-> Rep ApplyPendingMaintenanceAction x
Prelude.Generic)

-- |
-- Create a value of 'ApplyPendingMaintenanceAction' 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:
--
-- 'resourceIdentifier', 'applyPendingMaintenanceAction_resourceIdentifier' - The Amazon Resource Name (ARN) of the resource that the pending
-- maintenance action applies to. For information about creating an ARN,
-- see
-- <https://docs.aws.amazon.com/neptune/latest/UserGuide/tagging.ARN.html#tagging.ARN.Constructing Constructing an Amazon Resource Name (ARN)>.
--
-- 'applyAction', 'applyPendingMaintenanceAction_applyAction' - The pending maintenance action to apply to this resource.
--
-- Valid values: @system-update@, @db-upgrade@
--
-- 'optInType', 'applyPendingMaintenanceAction_optInType' - A value that specifies the type of opt-in request, or undoes an opt-in
-- request. An opt-in request of type @immediate@ can\'t be undone.
--
-- Valid values:
--
-- -   @immediate@ - Apply the maintenance action immediately.
--
-- -   @next-maintenance@ - Apply the maintenance action during the next
--     maintenance window for the resource.
--
-- -   @undo-opt-in@ - Cancel any existing @next-maintenance@ opt-in
--     requests.
newApplyPendingMaintenanceAction ::
  -- | 'resourceIdentifier'
  Prelude.Text ->
  -- | 'applyAction'
  Prelude.Text ->
  -- | 'optInType'
  Prelude.Text ->
  ApplyPendingMaintenanceAction
newApplyPendingMaintenanceAction :: Text -> Text -> Text -> ApplyPendingMaintenanceAction
newApplyPendingMaintenanceAction
  Text
pResourceIdentifier_
  Text
pApplyAction_
  Text
pOptInType_ =
    ApplyPendingMaintenanceAction'
      { $sel:resourceIdentifier:ApplyPendingMaintenanceAction' :: Text
resourceIdentifier =
          Text
pResourceIdentifier_,
        $sel:applyAction:ApplyPendingMaintenanceAction' :: Text
applyAction = Text
pApplyAction_,
        $sel:optInType:ApplyPendingMaintenanceAction' :: Text
optInType = Text
pOptInType_
      }

-- | The Amazon Resource Name (ARN) of the resource that the pending
-- maintenance action applies to. For information about creating an ARN,
-- see
-- <https://docs.aws.amazon.com/neptune/latest/UserGuide/tagging.ARN.html#tagging.ARN.Constructing Constructing an Amazon Resource Name (ARN)>.
applyPendingMaintenanceAction_resourceIdentifier :: Lens.Lens' ApplyPendingMaintenanceAction Prelude.Text
applyPendingMaintenanceAction_resourceIdentifier :: Lens' ApplyPendingMaintenanceAction Text
applyPendingMaintenanceAction_resourceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyPendingMaintenanceAction' {Text
resourceIdentifier :: Text
$sel:resourceIdentifier:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
resourceIdentifier} -> Text
resourceIdentifier) (\s :: ApplyPendingMaintenanceAction
s@ApplyPendingMaintenanceAction' {} Text
a -> ApplyPendingMaintenanceAction
s {$sel:resourceIdentifier:ApplyPendingMaintenanceAction' :: Text
resourceIdentifier = Text
a} :: ApplyPendingMaintenanceAction)

-- | The pending maintenance action to apply to this resource.
--
-- Valid values: @system-update@, @db-upgrade@
applyPendingMaintenanceAction_applyAction :: Lens.Lens' ApplyPendingMaintenanceAction Prelude.Text
applyPendingMaintenanceAction_applyAction :: Lens' ApplyPendingMaintenanceAction Text
applyPendingMaintenanceAction_applyAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyPendingMaintenanceAction' {Text
applyAction :: Text
$sel:applyAction:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
applyAction} -> Text
applyAction) (\s :: ApplyPendingMaintenanceAction
s@ApplyPendingMaintenanceAction' {} Text
a -> ApplyPendingMaintenanceAction
s {$sel:applyAction:ApplyPendingMaintenanceAction' :: Text
applyAction = Text
a} :: ApplyPendingMaintenanceAction)

-- | A value that specifies the type of opt-in request, or undoes an opt-in
-- request. An opt-in request of type @immediate@ can\'t be undone.
--
-- Valid values:
--
-- -   @immediate@ - Apply the maintenance action immediately.
--
-- -   @next-maintenance@ - Apply the maintenance action during the next
--     maintenance window for the resource.
--
-- -   @undo-opt-in@ - Cancel any existing @next-maintenance@ opt-in
--     requests.
applyPendingMaintenanceAction_optInType :: Lens.Lens' ApplyPendingMaintenanceAction Prelude.Text
applyPendingMaintenanceAction_optInType :: Lens' ApplyPendingMaintenanceAction Text
applyPendingMaintenanceAction_optInType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyPendingMaintenanceAction' {Text
optInType :: Text
$sel:optInType:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
optInType} -> Text
optInType) (\s :: ApplyPendingMaintenanceAction
s@ApplyPendingMaintenanceAction' {} Text
a -> ApplyPendingMaintenanceAction
s {$sel:optInType:ApplyPendingMaintenanceAction' :: Text
optInType = Text
a} :: ApplyPendingMaintenanceAction)

instance
  Core.AWSRequest
    ApplyPendingMaintenanceAction
  where
  type
    AWSResponse ApplyPendingMaintenanceAction =
      ApplyPendingMaintenanceActionResponse
  request :: (Service -> Service)
-> ApplyPendingMaintenanceAction
-> Request ApplyPendingMaintenanceAction
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 ApplyPendingMaintenanceAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ApplyPendingMaintenanceAction)))
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
"ApplyPendingMaintenanceActionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ResourcePendingMaintenanceActions
-> Int -> ApplyPendingMaintenanceActionResponse
ApplyPendingMaintenanceActionResponse'
            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
"ResourcePendingMaintenanceActions")
            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
    ApplyPendingMaintenanceAction
  where
  hashWithSalt :: Int -> ApplyPendingMaintenanceAction -> Int
hashWithSalt Int
_salt ApplyPendingMaintenanceAction' {Text
optInType :: Text
applyAction :: Text
resourceIdentifier :: Text
$sel:optInType:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
$sel:applyAction:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
$sel:resourceIdentifier:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applyAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
optInType

instance Prelude.NFData ApplyPendingMaintenanceAction where
  rnf :: ApplyPendingMaintenanceAction -> ()
rnf ApplyPendingMaintenanceAction' {Text
optInType :: Text
applyAction :: Text
resourceIdentifier :: Text
$sel:optInType:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
$sel:applyAction:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
$sel:resourceIdentifier:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resourceIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applyAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
optInType

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

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

instance Data.ToQuery ApplyPendingMaintenanceAction where
  toQuery :: ApplyPendingMaintenanceAction -> QueryString
toQuery ApplyPendingMaintenanceAction' {Text
optInType :: Text
applyAction :: Text
resourceIdentifier :: Text
$sel:optInType:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
$sel:applyAction:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
$sel:resourceIdentifier:ApplyPendingMaintenanceAction' :: ApplyPendingMaintenanceAction -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ApplyPendingMaintenanceAction" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"ResourceIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
resourceIdentifier,
        ByteString
"ApplyAction" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
applyAction,
        ByteString
"OptInType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
optInType
      ]

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

-- |
-- Create a value of 'ApplyPendingMaintenanceActionResponse' 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:
--
-- 'resourcePendingMaintenanceActions', 'applyPendingMaintenanceActionResponse_resourcePendingMaintenanceActions' - Undocumented member.
--
-- 'httpStatus', 'applyPendingMaintenanceActionResponse_httpStatus' - The response's http status code.
newApplyPendingMaintenanceActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ApplyPendingMaintenanceActionResponse
newApplyPendingMaintenanceActionResponse :: Int -> ApplyPendingMaintenanceActionResponse
newApplyPendingMaintenanceActionResponse Int
pHttpStatus_ =
  ApplyPendingMaintenanceActionResponse'
    { $sel:resourcePendingMaintenanceActions:ApplyPendingMaintenanceActionResponse' :: Maybe ResourcePendingMaintenanceActions
resourcePendingMaintenanceActions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ApplyPendingMaintenanceActionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
applyPendingMaintenanceActionResponse_resourcePendingMaintenanceActions :: Lens.Lens' ApplyPendingMaintenanceActionResponse (Prelude.Maybe ResourcePendingMaintenanceActions)
applyPendingMaintenanceActionResponse_resourcePendingMaintenanceActions :: Lens'
  ApplyPendingMaintenanceActionResponse
  (Maybe ResourcePendingMaintenanceActions)
applyPendingMaintenanceActionResponse_resourcePendingMaintenanceActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyPendingMaintenanceActionResponse' {Maybe ResourcePendingMaintenanceActions
resourcePendingMaintenanceActions :: Maybe ResourcePendingMaintenanceActions
$sel:resourcePendingMaintenanceActions:ApplyPendingMaintenanceActionResponse' :: ApplyPendingMaintenanceActionResponse
-> Maybe ResourcePendingMaintenanceActions
resourcePendingMaintenanceActions} -> Maybe ResourcePendingMaintenanceActions
resourcePendingMaintenanceActions) (\s :: ApplyPendingMaintenanceActionResponse
s@ApplyPendingMaintenanceActionResponse' {} Maybe ResourcePendingMaintenanceActions
a -> ApplyPendingMaintenanceActionResponse
s {$sel:resourcePendingMaintenanceActions:ApplyPendingMaintenanceActionResponse' :: Maybe ResourcePendingMaintenanceActions
resourcePendingMaintenanceActions = Maybe ResourcePendingMaintenanceActions
a} :: ApplyPendingMaintenanceActionResponse)

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

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