{-# 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.DLM.UpdateLifecyclePolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified lifecycle policy.
--
-- For more information about updating a policy, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/view-modify-delete.html#modify Modify lifecycle policies>.
module Amazonka.DLM.UpdateLifecyclePolicy
  ( -- * Creating a Request
    UpdateLifecyclePolicy (..),
    newUpdateLifecyclePolicy,

    -- * Request Lenses
    updateLifecyclePolicy_description,
    updateLifecyclePolicy_executionRoleArn,
    updateLifecyclePolicy_policyDetails,
    updateLifecyclePolicy_state,
    updateLifecyclePolicy_policyId,

    -- * Destructuring the Response
    UpdateLifecyclePolicyResponse (..),
    newUpdateLifecyclePolicyResponse,

    -- * Response Lenses
    updateLifecyclePolicyResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.DLM.Types
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:/ 'newUpdateLifecyclePolicy' smart constructor.
data UpdateLifecyclePolicy = UpdateLifecyclePolicy'
  { -- | A description of the lifecycle policy.
    UpdateLifecyclePolicy -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the IAM role used to run the
    -- operations specified by the lifecycle policy.
    UpdateLifecyclePolicy -> Maybe Text
executionRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The configuration of the lifecycle policy. You cannot update the policy
    -- type or the resource type.
    UpdateLifecyclePolicy -> Maybe PolicyDetails
policyDetails :: Prelude.Maybe PolicyDetails,
    -- | The desired activation state of the lifecycle policy after creation.
    UpdateLifecyclePolicy -> Maybe SettablePolicyStateValues
state :: Prelude.Maybe SettablePolicyStateValues,
    -- | The identifier of the lifecycle policy.
    UpdateLifecyclePolicy -> Text
policyId :: Prelude.Text
  }
  deriving (UpdateLifecyclePolicy -> UpdateLifecyclePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLifecyclePolicy -> UpdateLifecyclePolicy -> Bool
$c/= :: UpdateLifecyclePolicy -> UpdateLifecyclePolicy -> Bool
== :: UpdateLifecyclePolicy -> UpdateLifecyclePolicy -> Bool
$c== :: UpdateLifecyclePolicy -> UpdateLifecyclePolicy -> Bool
Prelude.Eq, ReadPrec [UpdateLifecyclePolicy]
ReadPrec UpdateLifecyclePolicy
Int -> ReadS UpdateLifecyclePolicy
ReadS [UpdateLifecyclePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLifecyclePolicy]
$creadListPrec :: ReadPrec [UpdateLifecyclePolicy]
readPrec :: ReadPrec UpdateLifecyclePolicy
$creadPrec :: ReadPrec UpdateLifecyclePolicy
readList :: ReadS [UpdateLifecyclePolicy]
$creadList :: ReadS [UpdateLifecyclePolicy]
readsPrec :: Int -> ReadS UpdateLifecyclePolicy
$creadsPrec :: Int -> ReadS UpdateLifecyclePolicy
Prelude.Read, Int -> UpdateLifecyclePolicy -> ShowS
[UpdateLifecyclePolicy] -> ShowS
UpdateLifecyclePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLifecyclePolicy] -> ShowS
$cshowList :: [UpdateLifecyclePolicy] -> ShowS
show :: UpdateLifecyclePolicy -> String
$cshow :: UpdateLifecyclePolicy -> String
showsPrec :: Int -> UpdateLifecyclePolicy -> ShowS
$cshowsPrec :: Int -> UpdateLifecyclePolicy -> ShowS
Prelude.Show, forall x. Rep UpdateLifecyclePolicy x -> UpdateLifecyclePolicy
forall x. UpdateLifecyclePolicy -> Rep UpdateLifecyclePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLifecyclePolicy x -> UpdateLifecyclePolicy
$cfrom :: forall x. UpdateLifecyclePolicy -> Rep UpdateLifecyclePolicy x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLifecyclePolicy' 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:
--
-- 'description', 'updateLifecyclePolicy_description' - A description of the lifecycle policy.
--
-- 'executionRoleArn', 'updateLifecyclePolicy_executionRoleArn' - The Amazon Resource Name (ARN) of the IAM role used to run the
-- operations specified by the lifecycle policy.
--
-- 'policyDetails', 'updateLifecyclePolicy_policyDetails' - The configuration of the lifecycle policy. You cannot update the policy
-- type or the resource type.
--
-- 'state', 'updateLifecyclePolicy_state' - The desired activation state of the lifecycle policy after creation.
--
-- 'policyId', 'updateLifecyclePolicy_policyId' - The identifier of the lifecycle policy.
newUpdateLifecyclePolicy ::
  -- | 'policyId'
  Prelude.Text ->
  UpdateLifecyclePolicy
newUpdateLifecyclePolicy :: Text -> UpdateLifecyclePolicy
newUpdateLifecyclePolicy Text
pPolicyId_ =
  UpdateLifecyclePolicy'
    { $sel:description:UpdateLifecyclePolicy' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:executionRoleArn:UpdateLifecyclePolicy' :: Maybe Text
executionRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:policyDetails:UpdateLifecyclePolicy' :: Maybe PolicyDetails
policyDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:state:UpdateLifecyclePolicy' :: Maybe SettablePolicyStateValues
state = forall a. Maybe a
Prelude.Nothing,
      $sel:policyId:UpdateLifecyclePolicy' :: Text
policyId = Text
pPolicyId_
    }

-- | A description of the lifecycle policy.
updateLifecyclePolicy_description :: Lens.Lens' UpdateLifecyclePolicy (Prelude.Maybe Prelude.Text)
updateLifecyclePolicy_description :: Lens' UpdateLifecyclePolicy (Maybe Text)
updateLifecyclePolicy_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLifecyclePolicy' {Maybe Text
description :: Maybe Text
$sel:description:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateLifecyclePolicy
s@UpdateLifecyclePolicy' {} Maybe Text
a -> UpdateLifecyclePolicy
s {$sel:description:UpdateLifecyclePolicy' :: Maybe Text
description = Maybe Text
a} :: UpdateLifecyclePolicy)

-- | The Amazon Resource Name (ARN) of the IAM role used to run the
-- operations specified by the lifecycle policy.
updateLifecyclePolicy_executionRoleArn :: Lens.Lens' UpdateLifecyclePolicy (Prelude.Maybe Prelude.Text)
updateLifecyclePolicy_executionRoleArn :: Lens' UpdateLifecyclePolicy (Maybe Text)
updateLifecyclePolicy_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLifecyclePolicy' {Maybe Text
executionRoleArn :: Maybe Text
$sel:executionRoleArn:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
executionRoleArn} -> Maybe Text
executionRoleArn) (\s :: UpdateLifecyclePolicy
s@UpdateLifecyclePolicy' {} Maybe Text
a -> UpdateLifecyclePolicy
s {$sel:executionRoleArn:UpdateLifecyclePolicy' :: Maybe Text
executionRoleArn = Maybe Text
a} :: UpdateLifecyclePolicy)

-- | The configuration of the lifecycle policy. You cannot update the policy
-- type or the resource type.
updateLifecyclePolicy_policyDetails :: Lens.Lens' UpdateLifecyclePolicy (Prelude.Maybe PolicyDetails)
updateLifecyclePolicy_policyDetails :: Lens' UpdateLifecyclePolicy (Maybe PolicyDetails)
updateLifecyclePolicy_policyDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLifecyclePolicy' {Maybe PolicyDetails
policyDetails :: Maybe PolicyDetails
$sel:policyDetails:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe PolicyDetails
policyDetails} -> Maybe PolicyDetails
policyDetails) (\s :: UpdateLifecyclePolicy
s@UpdateLifecyclePolicy' {} Maybe PolicyDetails
a -> UpdateLifecyclePolicy
s {$sel:policyDetails:UpdateLifecyclePolicy' :: Maybe PolicyDetails
policyDetails = Maybe PolicyDetails
a} :: UpdateLifecyclePolicy)

-- | The desired activation state of the lifecycle policy after creation.
updateLifecyclePolicy_state :: Lens.Lens' UpdateLifecyclePolicy (Prelude.Maybe SettablePolicyStateValues)
updateLifecyclePolicy_state :: Lens' UpdateLifecyclePolicy (Maybe SettablePolicyStateValues)
updateLifecyclePolicy_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLifecyclePolicy' {Maybe SettablePolicyStateValues
state :: Maybe SettablePolicyStateValues
$sel:state:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe SettablePolicyStateValues
state} -> Maybe SettablePolicyStateValues
state) (\s :: UpdateLifecyclePolicy
s@UpdateLifecyclePolicy' {} Maybe SettablePolicyStateValues
a -> UpdateLifecyclePolicy
s {$sel:state:UpdateLifecyclePolicy' :: Maybe SettablePolicyStateValues
state = Maybe SettablePolicyStateValues
a} :: UpdateLifecyclePolicy)

-- | The identifier of the lifecycle policy.
updateLifecyclePolicy_policyId :: Lens.Lens' UpdateLifecyclePolicy Prelude.Text
updateLifecyclePolicy_policyId :: Lens' UpdateLifecyclePolicy Text
updateLifecyclePolicy_policyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLifecyclePolicy' {Text
policyId :: Text
$sel:policyId:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Text
policyId} -> Text
policyId) (\s :: UpdateLifecyclePolicy
s@UpdateLifecyclePolicy' {} Text
a -> UpdateLifecyclePolicy
s {$sel:policyId:UpdateLifecyclePolicy' :: Text
policyId = Text
a} :: UpdateLifecyclePolicy)

instance Core.AWSRequest UpdateLifecyclePolicy where
  type
    AWSResponse UpdateLifecyclePolicy =
      UpdateLifecyclePolicyResponse
  request :: (Service -> Service)
-> UpdateLifecyclePolicy -> Request UpdateLifecyclePolicy
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateLifecyclePolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateLifecyclePolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateLifecyclePolicyResponse
UpdateLifecyclePolicyResponse'
            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 UpdateLifecyclePolicy where
  hashWithSalt :: Int -> UpdateLifecyclePolicy -> Int
hashWithSalt Int
_salt UpdateLifecyclePolicy' {Maybe Text
Maybe SettablePolicyStateValues
Maybe PolicyDetails
Text
policyId :: Text
state :: Maybe SettablePolicyStateValues
policyDetails :: Maybe PolicyDetails
executionRoleArn :: Maybe Text
description :: Maybe Text
$sel:policyId:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Text
$sel:state:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe SettablePolicyStateValues
$sel:policyDetails:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe PolicyDetails
$sel:executionRoleArn:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
$sel:description:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PolicyDetails
policyDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SettablePolicyStateValues
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyId

instance Prelude.NFData UpdateLifecyclePolicy where
  rnf :: UpdateLifecyclePolicy -> ()
rnf UpdateLifecyclePolicy' {Maybe Text
Maybe SettablePolicyStateValues
Maybe PolicyDetails
Text
policyId :: Text
state :: Maybe SettablePolicyStateValues
policyDetails :: Maybe PolicyDetails
executionRoleArn :: Maybe Text
description :: Maybe Text
$sel:policyId:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Text
$sel:state:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe SettablePolicyStateValues
$sel:policyDetails:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe PolicyDetails
$sel:executionRoleArn:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
$sel:description:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PolicyDetails
policyDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SettablePolicyStateValues
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policyId

instance Data.ToHeaders UpdateLifecyclePolicy where
  toHeaders :: UpdateLifecyclePolicy -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateLifecyclePolicy where
  toJSON :: UpdateLifecyclePolicy -> Value
toJSON UpdateLifecyclePolicy' {Maybe Text
Maybe SettablePolicyStateValues
Maybe PolicyDetails
Text
policyId :: Text
state :: Maybe SettablePolicyStateValues
policyDetails :: Maybe PolicyDetails
executionRoleArn :: Maybe Text
description :: Maybe Text
$sel:policyId:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Text
$sel:state:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe SettablePolicyStateValues
$sel:policyDetails:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe PolicyDetails
$sel:executionRoleArn:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
$sel:description:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"ExecutionRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
executionRoleArn,
            (Key
"PolicyDetails" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe PolicyDetails
policyDetails,
            (Key
"State" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SettablePolicyStateValues
state
          ]
      )

instance Data.ToPath UpdateLifecyclePolicy where
  toPath :: UpdateLifecyclePolicy -> ByteString
toPath UpdateLifecyclePolicy' {Maybe Text
Maybe SettablePolicyStateValues
Maybe PolicyDetails
Text
policyId :: Text
state :: Maybe SettablePolicyStateValues
policyDetails :: Maybe PolicyDetails
executionRoleArn :: Maybe Text
description :: Maybe Text
$sel:policyId:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Text
$sel:state:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe SettablePolicyStateValues
$sel:policyDetails:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe PolicyDetails
$sel:executionRoleArn:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
$sel:description:UpdateLifecyclePolicy' :: UpdateLifecyclePolicy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/policies/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
policyId]

instance Data.ToQuery UpdateLifecyclePolicy where
  toQuery :: UpdateLifecyclePolicy -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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