{-# 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.UnlockRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Unlocks a retention rule. After a retention rule is unlocked, it can be
-- modified or deleted only after the unlock delay period expires.
module Amazonka.RBin.UnlockRule
  ( -- * Creating a Request
    UnlockRule (..),
    newUnlockRule,

    -- * Request Lenses
    unlockRule_identifier,

    -- * Destructuring the Response
    UnlockRuleResponse (..),
    newUnlockRuleResponse,

    -- * Response Lenses
    unlockRuleResponse_description,
    unlockRuleResponse_identifier,
    unlockRuleResponse_lockConfiguration,
    unlockRuleResponse_lockEndTime,
    unlockRuleResponse_lockState,
    unlockRuleResponse_resourceTags,
    unlockRuleResponse_resourceType,
    unlockRuleResponse_retentionPeriod,
    unlockRuleResponse_status,
    unlockRuleResponse_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:/ 'newUnlockRule' smart constructor.
data UnlockRule = UnlockRule'
  { -- | The unique ID of the retention rule.
    UnlockRule -> Text
identifier :: Prelude.Text
  }
  deriving (UnlockRule -> UnlockRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnlockRule -> UnlockRule -> Bool
$c/= :: UnlockRule -> UnlockRule -> Bool
== :: UnlockRule -> UnlockRule -> Bool
$c== :: UnlockRule -> UnlockRule -> Bool
Prelude.Eq, ReadPrec [UnlockRule]
ReadPrec UnlockRule
Int -> ReadS UnlockRule
ReadS [UnlockRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnlockRule]
$creadListPrec :: ReadPrec [UnlockRule]
readPrec :: ReadPrec UnlockRule
$creadPrec :: ReadPrec UnlockRule
readList :: ReadS [UnlockRule]
$creadList :: ReadS [UnlockRule]
readsPrec :: Int -> ReadS UnlockRule
$creadsPrec :: Int -> ReadS UnlockRule
Prelude.Read, Int -> UnlockRule -> ShowS
[UnlockRule] -> ShowS
UnlockRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnlockRule] -> ShowS
$cshowList :: [UnlockRule] -> ShowS
show :: UnlockRule -> String
$cshow :: UnlockRule -> String
showsPrec :: Int -> UnlockRule -> ShowS
$cshowsPrec :: Int -> UnlockRule -> ShowS
Prelude.Show, forall x. Rep UnlockRule x -> UnlockRule
forall x. UnlockRule -> Rep UnlockRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnlockRule x -> UnlockRule
$cfrom :: forall x. UnlockRule -> Rep UnlockRule x
Prelude.Generic)

-- |
-- Create a value of 'UnlockRule' 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', 'unlockRule_identifier' - The unique ID of the retention rule.
newUnlockRule ::
  -- | 'identifier'
  Prelude.Text ->
  UnlockRule
newUnlockRule :: Text -> UnlockRule
newUnlockRule Text
pIdentifier_ =
  UnlockRule' {$sel:identifier:UnlockRule' :: Text
identifier = Text
pIdentifier_}

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

instance Core.AWSRequest UnlockRule where
  type AWSResponse UnlockRule = UnlockRuleResponse
  request :: (Service -> Service) -> UnlockRule -> Request UnlockRule
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 UnlockRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UnlockRule)))
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 POSIX
-> Maybe LockState
-> Maybe [ResourceTag]
-> Maybe ResourceType
-> Maybe RetentionPeriod
-> Maybe RuleStatus
-> Int
-> UnlockRuleResponse
UnlockRuleResponse'
            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
"LockEndTime")
            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 UnlockRule where
  hashWithSalt :: Int -> UnlockRule -> Int
hashWithSalt Int
_salt UnlockRule' {Text
identifier :: Text
$sel:identifier:UnlockRule' :: UnlockRule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier

instance Prelude.NFData UnlockRule where
  rnf :: UnlockRule -> ()
rnf UnlockRule' {Text
identifier :: Text
$sel:identifier:UnlockRule' :: UnlockRule -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
identifier

instance Data.ToHeaders UnlockRule where
  toHeaders :: UnlockRule -> 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 UnlockRule where
  toJSON :: UnlockRule -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

-- | /See:/ 'newUnlockRuleResponse' smart constructor.
data UnlockRuleResponse = UnlockRuleResponse'
  { -- | The retention rule description.
    UnlockRuleResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique ID of the retention rule.
    UnlockRuleResponse -> Maybe Text
identifier :: Prelude.Maybe Prelude.Text,
    -- | Information about the retention rule lock configuration.
    UnlockRuleResponse -> Maybe LockConfiguration
lockConfiguration :: Prelude.Maybe LockConfiguration,
    -- | The date and time at which the unlock delay is set to expire. Only
    -- returned for retention rules that have been unlocked and that are still
    -- within the unlock delay period.
    UnlockRuleResponse -> Maybe POSIX
lockEndTime :: Prelude.Maybe Data.POSIX,
    -- | 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@.
    UnlockRuleResponse -> Maybe LockState
lockState :: Prelude.Maybe LockState,
    -- | Information about the resource tags used to identify resources that are
    -- retained by the retention rule.
    UnlockRuleResponse -> Maybe [ResourceTag]
resourceTags :: Prelude.Maybe [ResourceTag],
    -- | The resource type retained by the retention rule.
    UnlockRuleResponse -> Maybe ResourceType
resourceType :: Prelude.Maybe ResourceType,
    UnlockRuleResponse -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | The state of the retention rule. Only retention rules that are in the
    -- @available@ state retain resources.
    UnlockRuleResponse -> Maybe RuleStatus
status :: Prelude.Maybe RuleStatus,
    -- | The response's http status code.
    UnlockRuleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UnlockRuleResponse -> UnlockRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnlockRuleResponse -> UnlockRuleResponse -> Bool
$c/= :: UnlockRuleResponse -> UnlockRuleResponse -> Bool
== :: UnlockRuleResponse -> UnlockRuleResponse -> Bool
$c== :: UnlockRuleResponse -> UnlockRuleResponse -> Bool
Prelude.Eq, ReadPrec [UnlockRuleResponse]
ReadPrec UnlockRuleResponse
Int -> ReadS UnlockRuleResponse
ReadS [UnlockRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnlockRuleResponse]
$creadListPrec :: ReadPrec [UnlockRuleResponse]
readPrec :: ReadPrec UnlockRuleResponse
$creadPrec :: ReadPrec UnlockRuleResponse
readList :: ReadS [UnlockRuleResponse]
$creadList :: ReadS [UnlockRuleResponse]
readsPrec :: Int -> ReadS UnlockRuleResponse
$creadsPrec :: Int -> ReadS UnlockRuleResponse
Prelude.Read, Int -> UnlockRuleResponse -> ShowS
[UnlockRuleResponse] -> ShowS
UnlockRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnlockRuleResponse] -> ShowS
$cshowList :: [UnlockRuleResponse] -> ShowS
show :: UnlockRuleResponse -> String
$cshow :: UnlockRuleResponse -> String
showsPrec :: Int -> UnlockRuleResponse -> ShowS
$cshowsPrec :: Int -> UnlockRuleResponse -> ShowS
Prelude.Show, forall x. Rep UnlockRuleResponse x -> UnlockRuleResponse
forall x. UnlockRuleResponse -> Rep UnlockRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnlockRuleResponse x -> UnlockRuleResponse
$cfrom :: forall x. UnlockRuleResponse -> Rep UnlockRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'UnlockRuleResponse' 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', 'unlockRuleResponse_description' - The retention rule description.
--
-- 'identifier', 'unlockRuleResponse_identifier' - The unique ID of the retention rule.
--
-- 'lockConfiguration', 'unlockRuleResponse_lockConfiguration' - Information about the retention rule lock configuration.
--
-- 'lockEndTime', 'unlockRuleResponse_lockEndTime' - The date and time at which the unlock delay is set to expire. Only
-- returned for retention rules that have been unlocked and that are still
-- within the unlock delay period.
--
-- 'lockState', 'unlockRuleResponse_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', 'unlockRuleResponse_resourceTags' - Information about the resource tags used to identify resources that are
-- retained by the retention rule.
--
-- 'resourceType', 'unlockRuleResponse_resourceType' - The resource type retained by the retention rule.
--
-- 'retentionPeriod', 'unlockRuleResponse_retentionPeriod' - Undocumented member.
--
-- 'status', 'unlockRuleResponse_status' - The state of the retention rule. Only retention rules that are in the
-- @available@ state retain resources.
--
-- 'httpStatus', 'unlockRuleResponse_httpStatus' - The response's http status code.
newUnlockRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UnlockRuleResponse
newUnlockRuleResponse :: Int -> UnlockRuleResponse
newUnlockRuleResponse Int
pHttpStatus_ =
  UnlockRuleResponse'
    { $sel:description:UnlockRuleResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:identifier:UnlockRuleResponse' :: Maybe Text
identifier = forall a. Maybe a
Prelude.Nothing,
      $sel:lockConfiguration:UnlockRuleResponse' :: Maybe LockConfiguration
lockConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:lockEndTime:UnlockRuleResponse' :: Maybe POSIX
lockEndTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lockState:UnlockRuleResponse' :: Maybe LockState
lockState = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceTags:UnlockRuleResponse' :: Maybe [ResourceTag]
resourceTags = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:UnlockRuleResponse' :: Maybe ResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:UnlockRuleResponse' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UnlockRuleResponse' :: Maybe RuleStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UnlockRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

-- | The date and time at which the unlock delay is set to expire. Only
-- returned for retention rules that have been unlocked and that are still
-- within the unlock delay period.
unlockRuleResponse_lockEndTime :: Lens.Lens' UnlockRuleResponse (Prelude.Maybe Prelude.UTCTime)
unlockRuleResponse_lockEndTime :: Lens' UnlockRuleResponse (Maybe UTCTime)
unlockRuleResponse_lockEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlockRuleResponse' {Maybe POSIX
lockEndTime :: Maybe POSIX
$sel:lockEndTime:UnlockRuleResponse' :: UnlockRuleResponse -> Maybe POSIX
lockEndTime} -> Maybe POSIX
lockEndTime) (\s :: UnlockRuleResponse
s@UnlockRuleResponse' {} Maybe POSIX
a -> UnlockRuleResponse
s {$sel:lockEndTime:UnlockRuleResponse' :: Maybe POSIX
lockEndTime = Maybe POSIX
a} :: UnlockRuleResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | 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@.
unlockRuleResponse_lockState :: Lens.Lens' UnlockRuleResponse (Prelude.Maybe LockState)
unlockRuleResponse_lockState :: Lens' UnlockRuleResponse (Maybe LockState)
unlockRuleResponse_lockState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlockRuleResponse' {Maybe LockState
lockState :: Maybe LockState
$sel:lockState:UnlockRuleResponse' :: UnlockRuleResponse -> Maybe LockState
lockState} -> Maybe LockState
lockState) (\s :: UnlockRuleResponse
s@UnlockRuleResponse' {} Maybe LockState
a -> UnlockRuleResponse
s {$sel:lockState:UnlockRuleResponse' :: Maybe LockState
lockState = Maybe LockState
a} :: UnlockRuleResponse)

-- | Information about the resource tags used to identify resources that are
-- retained by the retention rule.
unlockRuleResponse_resourceTags :: Lens.Lens' UnlockRuleResponse (Prelude.Maybe [ResourceTag])
unlockRuleResponse_resourceTags :: Lens' UnlockRuleResponse (Maybe [ResourceTag])
unlockRuleResponse_resourceTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlockRuleResponse' {Maybe [ResourceTag]
resourceTags :: Maybe [ResourceTag]
$sel:resourceTags:UnlockRuleResponse' :: UnlockRuleResponse -> Maybe [ResourceTag]
resourceTags} -> Maybe [ResourceTag]
resourceTags) (\s :: UnlockRuleResponse
s@UnlockRuleResponse' {} Maybe [ResourceTag]
a -> UnlockRuleResponse
s {$sel:resourceTags:UnlockRuleResponse' :: Maybe [ResourceTag]
resourceTags = Maybe [ResourceTag]
a} :: UnlockRuleResponse) 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.
unlockRuleResponse_resourceType :: Lens.Lens' UnlockRuleResponse (Prelude.Maybe ResourceType)
unlockRuleResponse_resourceType :: Lens' UnlockRuleResponse (Maybe ResourceType)
unlockRuleResponse_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlockRuleResponse' {Maybe ResourceType
resourceType :: Maybe ResourceType
$sel:resourceType:UnlockRuleResponse' :: UnlockRuleResponse -> Maybe ResourceType
resourceType} -> Maybe ResourceType
resourceType) (\s :: UnlockRuleResponse
s@UnlockRuleResponse' {} Maybe ResourceType
a -> UnlockRuleResponse
s {$sel:resourceType:UnlockRuleResponse' :: Maybe ResourceType
resourceType = Maybe ResourceType
a} :: UnlockRuleResponse)

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

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

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

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