{-# 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.ElasticBeanstalk.ApplyEnvironmentManagedAction
-- 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 scheduled managed action immediately. A managed action can be
-- applied only if its status is @Scheduled@. Get the status and action ID
-- of a managed action with DescribeEnvironmentManagedActions.
module Amazonka.ElasticBeanstalk.ApplyEnvironmentManagedAction
  ( -- * Creating a Request
    ApplyEnvironmentManagedAction (..),
    newApplyEnvironmentManagedAction,

    -- * Request Lenses
    applyEnvironmentManagedAction_environmentId,
    applyEnvironmentManagedAction_environmentName,
    applyEnvironmentManagedAction_actionId,

    -- * Destructuring the Response
    ApplyEnvironmentManagedActionResponse (..),
    newApplyEnvironmentManagedActionResponse,

    -- * Response Lenses
    applyEnvironmentManagedActionResponse_actionDescription,
    applyEnvironmentManagedActionResponse_actionId,
    applyEnvironmentManagedActionResponse_actionType,
    applyEnvironmentManagedActionResponse_status,
    applyEnvironmentManagedActionResponse_httpStatus,
  )
where

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

-- | Request to execute a scheduled managed action immediately.
--
-- /See:/ 'newApplyEnvironmentManagedAction' smart constructor.
data ApplyEnvironmentManagedAction = ApplyEnvironmentManagedAction'
  { -- | The environment ID of the target environment.
    ApplyEnvironmentManagedAction -> Maybe Text
environmentId :: Prelude.Maybe Prelude.Text,
    -- | The name of the target environment.
    ApplyEnvironmentManagedAction -> Maybe Text
environmentName :: Prelude.Maybe Prelude.Text,
    -- | The action ID of the scheduled managed action to execute.
    ApplyEnvironmentManagedAction -> Text
actionId :: Prelude.Text
  }
  deriving (ApplyEnvironmentManagedAction
-> ApplyEnvironmentManagedAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyEnvironmentManagedAction
-> ApplyEnvironmentManagedAction -> Bool
$c/= :: ApplyEnvironmentManagedAction
-> ApplyEnvironmentManagedAction -> Bool
== :: ApplyEnvironmentManagedAction
-> ApplyEnvironmentManagedAction -> Bool
$c== :: ApplyEnvironmentManagedAction
-> ApplyEnvironmentManagedAction -> Bool
Prelude.Eq, ReadPrec [ApplyEnvironmentManagedAction]
ReadPrec ApplyEnvironmentManagedAction
Int -> ReadS ApplyEnvironmentManagedAction
ReadS [ApplyEnvironmentManagedAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplyEnvironmentManagedAction]
$creadListPrec :: ReadPrec [ApplyEnvironmentManagedAction]
readPrec :: ReadPrec ApplyEnvironmentManagedAction
$creadPrec :: ReadPrec ApplyEnvironmentManagedAction
readList :: ReadS [ApplyEnvironmentManagedAction]
$creadList :: ReadS [ApplyEnvironmentManagedAction]
readsPrec :: Int -> ReadS ApplyEnvironmentManagedAction
$creadsPrec :: Int -> ReadS ApplyEnvironmentManagedAction
Prelude.Read, Int -> ApplyEnvironmentManagedAction -> ShowS
[ApplyEnvironmentManagedAction] -> ShowS
ApplyEnvironmentManagedAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyEnvironmentManagedAction] -> ShowS
$cshowList :: [ApplyEnvironmentManagedAction] -> ShowS
show :: ApplyEnvironmentManagedAction -> String
$cshow :: ApplyEnvironmentManagedAction -> String
showsPrec :: Int -> ApplyEnvironmentManagedAction -> ShowS
$cshowsPrec :: Int -> ApplyEnvironmentManagedAction -> ShowS
Prelude.Show, forall x.
Rep ApplyEnvironmentManagedAction x
-> ApplyEnvironmentManagedAction
forall x.
ApplyEnvironmentManagedAction
-> Rep ApplyEnvironmentManagedAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApplyEnvironmentManagedAction x
-> ApplyEnvironmentManagedAction
$cfrom :: forall x.
ApplyEnvironmentManagedAction
-> Rep ApplyEnvironmentManagedAction x
Prelude.Generic)

-- |
-- Create a value of 'ApplyEnvironmentManagedAction' 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:
--
-- 'environmentId', 'applyEnvironmentManagedAction_environmentId' - The environment ID of the target environment.
--
-- 'environmentName', 'applyEnvironmentManagedAction_environmentName' - The name of the target environment.
--
-- 'actionId', 'applyEnvironmentManagedAction_actionId' - The action ID of the scheduled managed action to execute.
newApplyEnvironmentManagedAction ::
  -- | 'actionId'
  Prelude.Text ->
  ApplyEnvironmentManagedAction
newApplyEnvironmentManagedAction :: Text -> ApplyEnvironmentManagedAction
newApplyEnvironmentManagedAction Text
pActionId_ =
  ApplyEnvironmentManagedAction'
    { $sel:environmentId:ApplyEnvironmentManagedAction' :: Maybe Text
environmentId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:environmentName:ApplyEnvironmentManagedAction' :: Maybe Text
environmentName = forall a. Maybe a
Prelude.Nothing,
      $sel:actionId:ApplyEnvironmentManagedAction' :: Text
actionId = Text
pActionId_
    }

-- | The environment ID of the target environment.
applyEnvironmentManagedAction_environmentId :: Lens.Lens' ApplyEnvironmentManagedAction (Prelude.Maybe Prelude.Text)
applyEnvironmentManagedAction_environmentId :: Lens' ApplyEnvironmentManagedAction (Maybe Text)
applyEnvironmentManagedAction_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyEnvironmentManagedAction' {Maybe Text
environmentId :: Maybe Text
$sel:environmentId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
environmentId} -> Maybe Text
environmentId) (\s :: ApplyEnvironmentManagedAction
s@ApplyEnvironmentManagedAction' {} Maybe Text
a -> ApplyEnvironmentManagedAction
s {$sel:environmentId:ApplyEnvironmentManagedAction' :: Maybe Text
environmentId = Maybe Text
a} :: ApplyEnvironmentManagedAction)

-- | The name of the target environment.
applyEnvironmentManagedAction_environmentName :: Lens.Lens' ApplyEnvironmentManagedAction (Prelude.Maybe Prelude.Text)
applyEnvironmentManagedAction_environmentName :: Lens' ApplyEnvironmentManagedAction (Maybe Text)
applyEnvironmentManagedAction_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyEnvironmentManagedAction' {Maybe Text
environmentName :: Maybe Text
$sel:environmentName:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
environmentName} -> Maybe Text
environmentName) (\s :: ApplyEnvironmentManagedAction
s@ApplyEnvironmentManagedAction' {} Maybe Text
a -> ApplyEnvironmentManagedAction
s {$sel:environmentName:ApplyEnvironmentManagedAction' :: Maybe Text
environmentName = Maybe Text
a} :: ApplyEnvironmentManagedAction)

-- | The action ID of the scheduled managed action to execute.
applyEnvironmentManagedAction_actionId :: Lens.Lens' ApplyEnvironmentManagedAction Prelude.Text
applyEnvironmentManagedAction_actionId :: Lens' ApplyEnvironmentManagedAction Text
applyEnvironmentManagedAction_actionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyEnvironmentManagedAction' {Text
actionId :: Text
$sel:actionId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Text
actionId} -> Text
actionId) (\s :: ApplyEnvironmentManagedAction
s@ApplyEnvironmentManagedAction' {} Text
a -> ApplyEnvironmentManagedAction
s {$sel:actionId:ApplyEnvironmentManagedAction' :: Text
actionId = Text
a} :: ApplyEnvironmentManagedAction)

instance
  Core.AWSRequest
    ApplyEnvironmentManagedAction
  where
  type
    AWSResponse ApplyEnvironmentManagedAction =
      ApplyEnvironmentManagedActionResponse
  request :: (Service -> Service)
-> ApplyEnvironmentManagedAction
-> Request ApplyEnvironmentManagedAction
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 ApplyEnvironmentManagedAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ApplyEnvironmentManagedAction)))
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
"ApplyEnvironmentManagedActionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe Text
-> Maybe ActionType
-> Maybe Text
-> Int
-> ApplyEnvironmentManagedActionResponse
ApplyEnvironmentManagedActionResponse'
            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
"ActionDescription")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ActionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ActionType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Status")
            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
    ApplyEnvironmentManagedAction
  where
  hashWithSalt :: Int -> ApplyEnvironmentManagedAction -> Int
hashWithSalt Int
_salt ApplyEnvironmentManagedAction' {Maybe Text
Text
actionId :: Text
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:actionId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Text
$sel:environmentName:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
$sel:environmentId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
actionId

instance Prelude.NFData ApplyEnvironmentManagedAction where
  rnf :: ApplyEnvironmentManagedAction -> ()
rnf ApplyEnvironmentManagedAction' {Maybe Text
Text
actionId :: Text
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:actionId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Text
$sel:environmentName:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
$sel:environmentId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
actionId

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

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

instance Data.ToQuery ApplyEnvironmentManagedAction where
  toQuery :: ApplyEnvironmentManagedAction -> QueryString
toQuery ApplyEnvironmentManagedAction' {Maybe Text
Text
actionId :: Text
environmentName :: Maybe Text
environmentId :: Maybe Text
$sel:actionId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Text
$sel:environmentName:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
$sel:environmentId:ApplyEnvironmentManagedAction' :: ApplyEnvironmentManagedAction -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ApplyEnvironmentManagedAction" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"EnvironmentId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
environmentId,
        ByteString
"EnvironmentName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
environmentName,
        ByteString
"ActionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
actionId
      ]

-- | The result message containing information about the managed action.
--
-- /See:/ 'newApplyEnvironmentManagedActionResponse' smart constructor.
data ApplyEnvironmentManagedActionResponse = ApplyEnvironmentManagedActionResponse'
  { -- | A description of the managed action.
    ApplyEnvironmentManagedActionResponse -> Maybe Text
actionDescription :: Prelude.Maybe Prelude.Text,
    -- | The action ID of the managed action.
    ApplyEnvironmentManagedActionResponse -> Maybe Text
actionId :: Prelude.Maybe Prelude.Text,
    -- | The type of managed action.
    ApplyEnvironmentManagedActionResponse -> Maybe ActionType
actionType :: Prelude.Maybe ActionType,
    -- | The status of the managed action.
    ApplyEnvironmentManagedActionResponse -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ApplyEnvironmentManagedActionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ApplyEnvironmentManagedActionResponse
-> ApplyEnvironmentManagedActionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyEnvironmentManagedActionResponse
-> ApplyEnvironmentManagedActionResponse -> Bool
$c/= :: ApplyEnvironmentManagedActionResponse
-> ApplyEnvironmentManagedActionResponse -> Bool
== :: ApplyEnvironmentManagedActionResponse
-> ApplyEnvironmentManagedActionResponse -> Bool
$c== :: ApplyEnvironmentManagedActionResponse
-> ApplyEnvironmentManagedActionResponse -> Bool
Prelude.Eq, ReadPrec [ApplyEnvironmentManagedActionResponse]
ReadPrec ApplyEnvironmentManagedActionResponse
Int -> ReadS ApplyEnvironmentManagedActionResponse
ReadS [ApplyEnvironmentManagedActionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplyEnvironmentManagedActionResponse]
$creadListPrec :: ReadPrec [ApplyEnvironmentManagedActionResponse]
readPrec :: ReadPrec ApplyEnvironmentManagedActionResponse
$creadPrec :: ReadPrec ApplyEnvironmentManagedActionResponse
readList :: ReadS [ApplyEnvironmentManagedActionResponse]
$creadList :: ReadS [ApplyEnvironmentManagedActionResponse]
readsPrec :: Int -> ReadS ApplyEnvironmentManagedActionResponse
$creadsPrec :: Int -> ReadS ApplyEnvironmentManagedActionResponse
Prelude.Read, Int -> ApplyEnvironmentManagedActionResponse -> ShowS
[ApplyEnvironmentManagedActionResponse] -> ShowS
ApplyEnvironmentManagedActionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyEnvironmentManagedActionResponse] -> ShowS
$cshowList :: [ApplyEnvironmentManagedActionResponse] -> ShowS
show :: ApplyEnvironmentManagedActionResponse -> String
$cshow :: ApplyEnvironmentManagedActionResponse -> String
showsPrec :: Int -> ApplyEnvironmentManagedActionResponse -> ShowS
$cshowsPrec :: Int -> ApplyEnvironmentManagedActionResponse -> ShowS
Prelude.Show, forall x.
Rep ApplyEnvironmentManagedActionResponse x
-> ApplyEnvironmentManagedActionResponse
forall x.
ApplyEnvironmentManagedActionResponse
-> Rep ApplyEnvironmentManagedActionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ApplyEnvironmentManagedActionResponse x
-> ApplyEnvironmentManagedActionResponse
$cfrom :: forall x.
ApplyEnvironmentManagedActionResponse
-> Rep ApplyEnvironmentManagedActionResponse x
Prelude.Generic)

-- |
-- Create a value of 'ApplyEnvironmentManagedActionResponse' 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:
--
-- 'actionDescription', 'applyEnvironmentManagedActionResponse_actionDescription' - A description of the managed action.
--
-- 'actionId', 'applyEnvironmentManagedActionResponse_actionId' - The action ID of the managed action.
--
-- 'actionType', 'applyEnvironmentManagedActionResponse_actionType' - The type of managed action.
--
-- 'status', 'applyEnvironmentManagedActionResponse_status' - The status of the managed action.
--
-- 'httpStatus', 'applyEnvironmentManagedActionResponse_httpStatus' - The response's http status code.
newApplyEnvironmentManagedActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ApplyEnvironmentManagedActionResponse
newApplyEnvironmentManagedActionResponse :: Int -> ApplyEnvironmentManagedActionResponse
newApplyEnvironmentManagedActionResponse Int
pHttpStatus_ =
  ApplyEnvironmentManagedActionResponse'
    { $sel:actionDescription:ApplyEnvironmentManagedActionResponse' :: Maybe Text
actionDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:actionId:ApplyEnvironmentManagedActionResponse' :: Maybe Text
actionId = forall a. Maybe a
Prelude.Nothing,
      $sel:actionType:ApplyEnvironmentManagedActionResponse' :: Maybe ActionType
actionType = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ApplyEnvironmentManagedActionResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ApplyEnvironmentManagedActionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the managed action.
applyEnvironmentManagedActionResponse_actionDescription :: Lens.Lens' ApplyEnvironmentManagedActionResponse (Prelude.Maybe Prelude.Text)
applyEnvironmentManagedActionResponse_actionDescription :: Lens' ApplyEnvironmentManagedActionResponse (Maybe Text)
applyEnvironmentManagedActionResponse_actionDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyEnvironmentManagedActionResponse' {Maybe Text
actionDescription :: Maybe Text
$sel:actionDescription:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe Text
actionDescription} -> Maybe Text
actionDescription) (\s :: ApplyEnvironmentManagedActionResponse
s@ApplyEnvironmentManagedActionResponse' {} Maybe Text
a -> ApplyEnvironmentManagedActionResponse
s {$sel:actionDescription:ApplyEnvironmentManagedActionResponse' :: Maybe Text
actionDescription = Maybe Text
a} :: ApplyEnvironmentManagedActionResponse)

-- | The action ID of the managed action.
applyEnvironmentManagedActionResponse_actionId :: Lens.Lens' ApplyEnvironmentManagedActionResponse (Prelude.Maybe Prelude.Text)
applyEnvironmentManagedActionResponse_actionId :: Lens' ApplyEnvironmentManagedActionResponse (Maybe Text)
applyEnvironmentManagedActionResponse_actionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyEnvironmentManagedActionResponse' {Maybe Text
actionId :: Maybe Text
$sel:actionId:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe Text
actionId} -> Maybe Text
actionId) (\s :: ApplyEnvironmentManagedActionResponse
s@ApplyEnvironmentManagedActionResponse' {} Maybe Text
a -> ApplyEnvironmentManagedActionResponse
s {$sel:actionId:ApplyEnvironmentManagedActionResponse' :: Maybe Text
actionId = Maybe Text
a} :: ApplyEnvironmentManagedActionResponse)

-- | The type of managed action.
applyEnvironmentManagedActionResponse_actionType :: Lens.Lens' ApplyEnvironmentManagedActionResponse (Prelude.Maybe ActionType)
applyEnvironmentManagedActionResponse_actionType :: Lens' ApplyEnvironmentManagedActionResponse (Maybe ActionType)
applyEnvironmentManagedActionResponse_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyEnvironmentManagedActionResponse' {Maybe ActionType
actionType :: Maybe ActionType
$sel:actionType:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe ActionType
actionType} -> Maybe ActionType
actionType) (\s :: ApplyEnvironmentManagedActionResponse
s@ApplyEnvironmentManagedActionResponse' {} Maybe ActionType
a -> ApplyEnvironmentManagedActionResponse
s {$sel:actionType:ApplyEnvironmentManagedActionResponse' :: Maybe ActionType
actionType = Maybe ActionType
a} :: ApplyEnvironmentManagedActionResponse)

-- | The status of the managed action.
applyEnvironmentManagedActionResponse_status :: Lens.Lens' ApplyEnvironmentManagedActionResponse (Prelude.Maybe Prelude.Text)
applyEnvironmentManagedActionResponse_status :: Lens' ApplyEnvironmentManagedActionResponse (Maybe Text)
applyEnvironmentManagedActionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplyEnvironmentManagedActionResponse' {Maybe Text
status :: Maybe Text
$sel:status:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe Text
status} -> Maybe Text
status) (\s :: ApplyEnvironmentManagedActionResponse
s@ApplyEnvironmentManagedActionResponse' {} Maybe Text
a -> ApplyEnvironmentManagedActionResponse
s {$sel:status:ApplyEnvironmentManagedActionResponse' :: Maybe Text
status = Maybe Text
a} :: ApplyEnvironmentManagedActionResponse)

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

instance
  Prelude.NFData
    ApplyEnvironmentManagedActionResponse
  where
  rnf :: ApplyEnvironmentManagedActionResponse -> ()
rnf ApplyEnvironmentManagedActionResponse' {Int
Maybe Text
Maybe ActionType
httpStatus :: Int
status :: Maybe Text
actionType :: Maybe ActionType
actionId :: Maybe Text
actionDescription :: Maybe Text
$sel:httpStatus:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Int
$sel:status:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe Text
$sel:actionType:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe ActionType
$sel:actionId:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe Text
$sel:actionDescription:ApplyEnvironmentManagedActionResponse' :: ApplyEnvironmentManagedActionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ActionType
actionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus