{-# 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.RBin.LockRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Locks a retention rule. A locked retention rule can\'t be modified or
-- deleted.
module Amazonka.RBin.LockRule
  ( -- * Creating a Request
    LockRule (..),
    newLockRule,

    -- * Request Lenses
    lockRule_identifier,
    lockRule_lockConfiguration,

    -- * Destructuring the Response
    LockRuleResponse (..),
    newLockRuleResponse,

    -- * Response Lenses
    lockRuleResponse_description,
    lockRuleResponse_identifier,
    lockRuleResponse_lockConfiguration,
    lockRuleResponse_lockState,
    lockRuleResponse_resourceTags,
    lockRuleResponse_resourceType,
    lockRuleResponse_retentionPeriod,
    lockRuleResponse_status,
    lockRuleResponse_httpStatus,
  )
where

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 Amazonka.RBin.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newLockRule' smart constructor.
data LockRule = LockRule'
  { -- | The unique ID of the retention rule.
    LockRule -> Text
identifier :: Prelude.Text,
    -- | Information about the retention rule lock configuration.
    LockRule -> LockConfiguration
lockConfiguration :: LockConfiguration
  }
  deriving (LockRule -> LockRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockRule -> LockRule -> Bool
$c/= :: LockRule -> LockRule -> Bool
== :: LockRule -> LockRule -> Bool
$c== :: LockRule -> LockRule -> Bool
Prelude.Eq, ReadPrec [LockRule]
ReadPrec LockRule
Int -> ReadS LockRule
ReadS [LockRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LockRule]
$creadListPrec :: ReadPrec [LockRule]
readPrec :: ReadPrec LockRule
$creadPrec :: ReadPrec LockRule
readList :: ReadS [LockRule]
$creadList :: ReadS [LockRule]
readsPrec :: Int -> ReadS LockRule
$creadsPrec :: Int -> ReadS LockRule
Prelude.Read, Int -> LockRule -> ShowS
[LockRule] -> ShowS
LockRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockRule] -> ShowS
$cshowList :: [LockRule] -> ShowS
show :: LockRule -> String
$cshow :: LockRule -> String
showsPrec :: Int -> LockRule -> ShowS
$cshowsPrec :: Int -> LockRule -> ShowS
Prelude.Show, forall x. Rep LockRule x -> LockRule
forall x. LockRule -> Rep LockRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LockRule x -> LockRule
$cfrom :: forall x. LockRule -> Rep LockRule x
Prelude.Generic)

-- |
-- Create a value of 'LockRule' 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:
--
-- 'identifier', 'lockRule_identifier' - The unique ID of the retention rule.
--
-- 'lockConfiguration', 'lockRule_lockConfiguration' - Information about the retention rule lock configuration.
newLockRule ::
  -- | 'identifier'
  Prelude.Text ->
  -- | 'lockConfiguration'
  LockConfiguration ->
  LockRule
newLockRule :: Text -> LockConfiguration -> LockRule
newLockRule Text
pIdentifier_ LockConfiguration
pLockConfiguration_ =
  LockRule'
    { $sel:identifier:LockRule' :: Text
identifier = Text
pIdentifier_,
      $sel:lockConfiguration:LockRule' :: LockConfiguration
lockConfiguration = LockConfiguration
pLockConfiguration_
    }

-- | The unique ID of the retention rule.
lockRule_identifier :: Lens.Lens' LockRule Prelude.Text
lockRule_identifier :: Lens' LockRule Text
lockRule_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRule' {Text
identifier :: Text
$sel:identifier:LockRule' :: LockRule -> Text
identifier} -> Text
identifier) (\s :: LockRule
s@LockRule' {} Text
a -> LockRule
s {$sel:identifier:LockRule' :: Text
identifier = Text
a} :: LockRule)

-- | Information about the retention rule lock configuration.
lockRule_lockConfiguration :: Lens.Lens' LockRule LockConfiguration
lockRule_lockConfiguration :: Lens' LockRule LockConfiguration
lockRule_lockConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRule' {LockConfiguration
lockConfiguration :: LockConfiguration
$sel:lockConfiguration:LockRule' :: LockRule -> LockConfiguration
lockConfiguration} -> LockConfiguration
lockConfiguration) (\s :: LockRule
s@LockRule' {} LockConfiguration
a -> LockRule
s {$sel:lockConfiguration:LockRule' :: LockConfiguration
lockConfiguration = LockConfiguration
a} :: LockRule)

instance Core.AWSRequest LockRule where
  type AWSResponse LockRule = LockRuleResponse
  request :: (Service -> Service) -> LockRule -> Request LockRule
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 LockRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse LockRule)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe LockConfiguration
-> Maybe LockState
-> Maybe [ResourceTag]
-> Maybe ResourceType
-> Maybe RetentionPeriod
-> Maybe RuleStatus
-> Int
-> LockRuleResponse
LockRuleResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Identifier")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LockConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LockState")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ResourceTags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ResourceType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RetentionPeriod")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"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 LockRule where
  hashWithSalt :: Int -> LockRule -> Int
hashWithSalt Int
_salt LockRule' {Text
LockConfiguration
lockConfiguration :: LockConfiguration
identifier :: Text
$sel:lockConfiguration:LockRule' :: LockRule -> LockConfiguration
$sel:identifier:LockRule' :: LockRule -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LockConfiguration
lockConfiguration

instance Prelude.NFData LockRule where
  rnf :: LockRule -> ()
rnf LockRule' {Text
LockConfiguration
lockConfiguration :: LockConfiguration
identifier :: Text
$sel:lockConfiguration:LockRule' :: LockRule -> LockConfiguration
$sel:identifier:LockRule' :: LockRule -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LockConfiguration
lockConfiguration

instance Data.ToHeaders LockRule where
  toHeaders :: LockRule -> 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 LockRule where
  toJSON :: LockRule -> Value
toJSON LockRule' {Text
LockConfiguration
lockConfiguration :: LockConfiguration
identifier :: Text
$sel:lockConfiguration:LockRule' :: LockRule -> LockConfiguration
$sel:identifier:LockRule' :: LockRule -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"LockConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LockConfiguration
lockConfiguration)
          ]
      )

instance Data.ToPath LockRule where
  toPath :: LockRule -> ByteString
toPath LockRule' {Text
LockConfiguration
lockConfiguration :: LockConfiguration
identifier :: Text
$sel:lockConfiguration:LockRule' :: LockRule -> LockConfiguration
$sel:identifier:LockRule' :: LockRule -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/rules/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
identifier, ByteString
"/lock"]

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

-- | /See:/ 'newLockRuleResponse' smart constructor.
data LockRuleResponse = LockRuleResponse'
  { -- | The retention rule description.
    LockRuleResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique ID of the retention rule.
    LockRuleResponse -> Maybe Text
identifier :: Prelude.Maybe Prelude.Text,
    -- | Information about the retention rule lock configuration.
    LockRuleResponse -> Maybe LockConfiguration
lockConfiguration :: Prelude.Maybe LockConfiguration,
    -- | The lock state for the retention rule.
    --
    -- -   @locked@ - The retention rule is locked and can\'t be modified or
    --     deleted.
    --
    -- -   @pending_unlock@ - The retention rule has been unlocked but it is
    --     still within the unlock delay period. The retention rule can be
    --     modified or deleted only after the unlock delay period has expired.
    --
    -- -   @unlocked@ - The retention rule is unlocked and it can be modified
    --     or deleted by any user with the required permissions.
    --
    -- -   @null@ - The retention rule has never been locked. Once a retention
    --     rule has been locked, it can transition between the @locked@ and
    --     @unlocked@ states only; it can never transition back to @null@.
    LockRuleResponse -> Maybe LockState
lockState :: Prelude.Maybe LockState,
    -- | Information about the resource tags used to identify resources that are
    -- retained by the retention rule.
    LockRuleResponse -> Maybe [ResourceTag]
resourceTags :: Prelude.Maybe [ResourceTag],
    -- | The resource type retained by the retention rule.
    LockRuleResponse -> Maybe ResourceType
resourceType :: Prelude.Maybe ResourceType,
    LockRuleResponse -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | The state of the retention rule. Only retention rules that are in the
    -- @available@ state retain resources.
    LockRuleResponse -> Maybe RuleStatus
status :: Prelude.Maybe RuleStatus,
    -- | The response's http status code.
    LockRuleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (LockRuleResponse -> LockRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockRuleResponse -> LockRuleResponse -> Bool
$c/= :: LockRuleResponse -> LockRuleResponse -> Bool
== :: LockRuleResponse -> LockRuleResponse -> Bool
$c== :: LockRuleResponse -> LockRuleResponse -> Bool
Prelude.Eq, ReadPrec [LockRuleResponse]
ReadPrec LockRuleResponse
Int -> ReadS LockRuleResponse
ReadS [LockRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LockRuleResponse]
$creadListPrec :: ReadPrec [LockRuleResponse]
readPrec :: ReadPrec LockRuleResponse
$creadPrec :: ReadPrec LockRuleResponse
readList :: ReadS [LockRuleResponse]
$creadList :: ReadS [LockRuleResponse]
readsPrec :: Int -> ReadS LockRuleResponse
$creadsPrec :: Int -> ReadS LockRuleResponse
Prelude.Read, Int -> LockRuleResponse -> ShowS
[LockRuleResponse] -> ShowS
LockRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockRuleResponse] -> ShowS
$cshowList :: [LockRuleResponse] -> ShowS
show :: LockRuleResponse -> String
$cshow :: LockRuleResponse -> String
showsPrec :: Int -> LockRuleResponse -> ShowS
$cshowsPrec :: Int -> LockRuleResponse -> ShowS
Prelude.Show, forall x. Rep LockRuleResponse x -> LockRuleResponse
forall x. LockRuleResponse -> Rep LockRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LockRuleResponse x -> LockRuleResponse
$cfrom :: forall x. LockRuleResponse -> Rep LockRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'LockRuleResponse' 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', 'lockRuleResponse_description' - The retention rule description.
--
-- 'identifier', 'lockRuleResponse_identifier' - The unique ID of the retention rule.
--
-- 'lockConfiguration', 'lockRuleResponse_lockConfiguration' - Information about the retention rule lock configuration.
--
-- 'lockState', 'lockRuleResponse_lockState' - The lock state for the retention rule.
--
-- -   @locked@ - The retention rule is locked and can\'t be modified or
--     deleted.
--
-- -   @pending_unlock@ - The retention rule has been unlocked but it is
--     still within the unlock delay period. The retention rule can be
--     modified or deleted only after the unlock delay period has expired.
--
-- -   @unlocked@ - The retention rule is unlocked and it can be modified
--     or deleted by any user with the required permissions.
--
-- -   @null@ - The retention rule has never been locked. Once a retention
--     rule has been locked, it can transition between the @locked@ and
--     @unlocked@ states only; it can never transition back to @null@.
--
-- 'resourceTags', 'lockRuleResponse_resourceTags' - Information about the resource tags used to identify resources that are
-- retained by the retention rule.
--
-- 'resourceType', 'lockRuleResponse_resourceType' - The resource type retained by the retention rule.
--
-- 'retentionPeriod', 'lockRuleResponse_retentionPeriod' - Undocumented member.
--
-- 'status', 'lockRuleResponse_status' - The state of the retention rule. Only retention rules that are in the
-- @available@ state retain resources.
--
-- 'httpStatus', 'lockRuleResponse_httpStatus' - The response's http status code.
newLockRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  LockRuleResponse
newLockRuleResponse :: Int -> LockRuleResponse
newLockRuleResponse Int
pHttpStatus_ =
  LockRuleResponse'
    { $sel:description:LockRuleResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:identifier:LockRuleResponse' :: Maybe Text
identifier = forall a. Maybe a
Prelude.Nothing,
      $sel:lockConfiguration:LockRuleResponse' :: Maybe LockConfiguration
lockConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:lockState:LockRuleResponse' :: Maybe LockState
lockState = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceTags:LockRuleResponse' :: Maybe [ResourceTag]
resourceTags = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:LockRuleResponse' :: Maybe ResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:LockRuleResponse' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:status:LockRuleResponse' :: Maybe RuleStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:LockRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The retention rule description.
lockRuleResponse_description :: Lens.Lens' LockRuleResponse (Prelude.Maybe Prelude.Text)
lockRuleResponse_description :: Lens' LockRuleResponse (Maybe Text)
lockRuleResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe Text
description :: Maybe Text
$sel:description:LockRuleResponse' :: LockRuleResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe Text
a -> LockRuleResponse
s {$sel:description:LockRuleResponse' :: Maybe Text
description = Maybe Text
a} :: LockRuleResponse)

-- | The unique ID of the retention rule.
lockRuleResponse_identifier :: Lens.Lens' LockRuleResponse (Prelude.Maybe Prelude.Text)
lockRuleResponse_identifier :: Lens' LockRuleResponse (Maybe Text)
lockRuleResponse_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe Text
identifier :: Maybe Text
$sel:identifier:LockRuleResponse' :: LockRuleResponse -> Maybe Text
identifier} -> Maybe Text
identifier) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe Text
a -> LockRuleResponse
s {$sel:identifier:LockRuleResponse' :: Maybe Text
identifier = Maybe Text
a} :: LockRuleResponse)

-- | Information about the retention rule lock configuration.
lockRuleResponse_lockConfiguration :: Lens.Lens' LockRuleResponse (Prelude.Maybe LockConfiguration)
lockRuleResponse_lockConfiguration :: Lens' LockRuleResponse (Maybe LockConfiguration)
lockRuleResponse_lockConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe LockConfiguration
lockConfiguration :: Maybe LockConfiguration
$sel:lockConfiguration:LockRuleResponse' :: LockRuleResponse -> Maybe LockConfiguration
lockConfiguration} -> Maybe LockConfiguration
lockConfiguration) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe LockConfiguration
a -> LockRuleResponse
s {$sel:lockConfiguration:LockRuleResponse' :: Maybe LockConfiguration
lockConfiguration = Maybe LockConfiguration
a} :: LockRuleResponse)

-- | The lock state for the retention rule.
--
-- -   @locked@ - The retention rule is locked and can\'t be modified or
--     deleted.
--
-- -   @pending_unlock@ - The retention rule has been unlocked but it is
--     still within the unlock delay period. The retention rule can be
--     modified or deleted only after the unlock delay period has expired.
--
-- -   @unlocked@ - The retention rule is unlocked and it can be modified
--     or deleted by any user with the required permissions.
--
-- -   @null@ - The retention rule has never been locked. Once a retention
--     rule has been locked, it can transition between the @locked@ and
--     @unlocked@ states only; it can never transition back to @null@.
lockRuleResponse_lockState :: Lens.Lens' LockRuleResponse (Prelude.Maybe LockState)
lockRuleResponse_lockState :: Lens' LockRuleResponse (Maybe LockState)
lockRuleResponse_lockState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe LockState
lockState :: Maybe LockState
$sel:lockState:LockRuleResponse' :: LockRuleResponse -> Maybe LockState
lockState} -> Maybe LockState
lockState) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe LockState
a -> LockRuleResponse
s {$sel:lockState:LockRuleResponse' :: Maybe LockState
lockState = Maybe LockState
a} :: LockRuleResponse)

-- | Information about the resource tags used to identify resources that are
-- retained by the retention rule.
lockRuleResponse_resourceTags :: Lens.Lens' LockRuleResponse (Prelude.Maybe [ResourceTag])
lockRuleResponse_resourceTags :: Lens' LockRuleResponse (Maybe [ResourceTag])
lockRuleResponse_resourceTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe [ResourceTag]
resourceTags :: Maybe [ResourceTag]
$sel:resourceTags:LockRuleResponse' :: LockRuleResponse -> Maybe [ResourceTag]
resourceTags} -> Maybe [ResourceTag]
resourceTags) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe [ResourceTag]
a -> LockRuleResponse
s {$sel:resourceTags:LockRuleResponse' :: Maybe [ResourceTag]
resourceTags = Maybe [ResourceTag]
a} :: LockRuleResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The resource type retained by the retention rule.
lockRuleResponse_resourceType :: Lens.Lens' LockRuleResponse (Prelude.Maybe ResourceType)
lockRuleResponse_resourceType :: Lens' LockRuleResponse (Maybe ResourceType)
lockRuleResponse_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe ResourceType
resourceType :: Maybe ResourceType
$sel:resourceType:LockRuleResponse' :: LockRuleResponse -> Maybe ResourceType
resourceType} -> Maybe ResourceType
resourceType) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe ResourceType
a -> LockRuleResponse
s {$sel:resourceType:LockRuleResponse' :: Maybe ResourceType
resourceType = Maybe ResourceType
a} :: LockRuleResponse)

-- | Undocumented member.
lockRuleResponse_retentionPeriod :: Lens.Lens' LockRuleResponse (Prelude.Maybe RetentionPeriod)
lockRuleResponse_retentionPeriod :: Lens' LockRuleResponse (Maybe RetentionPeriod)
lockRuleResponse_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:LockRuleResponse' :: LockRuleResponse -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe RetentionPeriod
a -> LockRuleResponse
s {$sel:retentionPeriod:LockRuleResponse' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: LockRuleResponse)

-- | The state of the retention rule. Only retention rules that are in the
-- @available@ state retain resources.
lockRuleResponse_status :: Lens.Lens' LockRuleResponse (Prelude.Maybe RuleStatus)
lockRuleResponse_status :: Lens' LockRuleResponse (Maybe RuleStatus)
lockRuleResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LockRuleResponse' {Maybe RuleStatus
status :: Maybe RuleStatus
$sel:status:LockRuleResponse' :: LockRuleResponse -> Maybe RuleStatus
status} -> Maybe RuleStatus
status) (\s :: LockRuleResponse
s@LockRuleResponse' {} Maybe RuleStatus
a -> LockRuleResponse
s {$sel:status:LockRuleResponse' :: Maybe RuleStatus
status = Maybe RuleStatus
a} :: LockRuleResponse)

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

instance Prelude.NFData LockRuleResponse where
  rnf :: LockRuleResponse -> ()
rnf LockRuleResponse' {Int
Maybe [ResourceTag]
Maybe Text
Maybe LockState
Maybe ResourceType
Maybe RetentionPeriod
Maybe RuleStatus
Maybe LockConfiguration
httpStatus :: Int
status :: Maybe RuleStatus
retentionPeriod :: Maybe RetentionPeriod
resourceType :: Maybe ResourceType
resourceTags :: Maybe [ResourceTag]
lockState :: Maybe LockState
lockConfiguration :: Maybe LockConfiguration
identifier :: Maybe Text
description :: Maybe Text
$sel:httpStatus:LockRuleResponse' :: LockRuleResponse -> Int
$sel:status:LockRuleResponse' :: LockRuleResponse -> Maybe RuleStatus
$sel:retentionPeriod:LockRuleResponse' :: LockRuleResponse -> Maybe RetentionPeriod
$sel:resourceType:LockRuleResponse' :: LockRuleResponse -> Maybe ResourceType
$sel:resourceTags:LockRuleResponse' :: LockRuleResponse -> Maybe [ResourceTag]
$sel:lockState:LockRuleResponse' :: LockRuleResponse -> Maybe LockState
$sel:lockConfiguration:LockRuleResponse' :: LockRuleResponse -> Maybe LockConfiguration
$sel:identifier:LockRuleResponse' :: LockRuleResponse -> Maybe Text
$sel:description:LockRuleResponse' :: LockRuleResponse -> 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
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LockConfiguration
lockConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LockState
lockState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResourceTag]
resourceTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionPeriod
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RuleStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus