{-# 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.GetRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a Recycle Bin retention rule.
module Amazonka.RBin.GetRule
  ( -- * Creating a Request
    GetRule (..),
    newGetRule,

    -- * Request Lenses
    getRule_identifier,

    -- * Destructuring the Response
    GetRuleResponse (..),
    newGetRuleResponse,

    -- * Response Lenses
    getRuleResponse_description,
    getRuleResponse_identifier,
    getRuleResponse_lockConfiguration,
    getRuleResponse_lockEndTime,
    getRuleResponse_lockState,
    getRuleResponse_resourceTags,
    getRuleResponse_resourceType,
    getRuleResponse_retentionPeriod,
    getRuleResponse_status,
    getRuleResponse_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:/ 'newGetRule' smart constructor.
data GetRule = GetRule'
  { -- | The unique ID of the retention rule.
    GetRule -> Text
identifier :: Prelude.Text
  }
  deriving (GetRule -> GetRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRule -> GetRule -> Bool
$c/= :: GetRule -> GetRule -> Bool
== :: GetRule -> GetRule -> Bool
$c== :: GetRule -> GetRule -> Bool
Prelude.Eq, ReadPrec [GetRule]
ReadPrec GetRule
Int -> ReadS GetRule
ReadS [GetRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRule]
$creadListPrec :: ReadPrec [GetRule]
readPrec :: ReadPrec GetRule
$creadPrec :: ReadPrec GetRule
readList :: ReadS [GetRule]
$creadList :: ReadS [GetRule]
readsPrec :: Int -> ReadS GetRule
$creadsPrec :: Int -> ReadS GetRule
Prelude.Read, Int -> GetRule -> ShowS
[GetRule] -> ShowS
GetRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRule] -> ShowS
$cshowList :: [GetRule] -> ShowS
show :: GetRule -> String
$cshow :: GetRule -> String
showsPrec :: Int -> GetRule -> ShowS
$cshowsPrec :: Int -> GetRule -> ShowS
Prelude.Show, forall x. Rep GetRule x -> GetRule
forall x. GetRule -> Rep GetRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRule x -> GetRule
$cfrom :: forall x. GetRule -> Rep GetRule x
Prelude.Generic)

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

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

instance Core.AWSRequest GetRule where
  type AWSResponse GetRule = GetRuleResponse
  request :: (Service -> Service) -> GetRule -> Request GetRule
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetRule)))
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
-> GetRuleResponse
GetRuleResponse'
            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 GetRule where
  hashWithSalt :: Int -> GetRule -> Int
hashWithSalt Int
_salt GetRule' {Text
identifier :: Text
$sel:identifier:GetRule' :: GetRule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier

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

instance Data.ToHeaders GetRule where
  toHeaders :: GetRule -> 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.ToPath GetRule where
  toPath :: GetRule -> ByteString
toPath GetRule' {Text
identifier :: Text
$sel:identifier:GetRule' :: GetRule -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/rules/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
identifier]

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

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

-- |
-- Create a value of 'GetRuleResponse' 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', 'getRuleResponse_description' - The retention rule description.
--
-- 'identifier', 'getRuleResponse_identifier' - The unique ID of the retention rule.
--
-- 'lockConfiguration', 'getRuleResponse_lockConfiguration' - Information about the retention rule lock configuration.
--
-- 'lockEndTime', 'getRuleResponse_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', 'getRuleResponse_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', 'getRuleResponse_resourceTags' - Information about the resource tags used to identify resources that are
-- retained by the retention rule.
--
-- 'resourceType', 'getRuleResponse_resourceType' - The resource type retained by the retention rule.
--
-- 'retentionPeriod', 'getRuleResponse_retentionPeriod' - Information about the retention period for which the retention rule is
-- to retain resources.
--
-- 'status', 'getRuleResponse_status' - The state of the retention rule. Only retention rules that are in the
-- @available@ state retain resources.
--
-- 'httpStatus', 'getRuleResponse_httpStatus' - The response's http status code.
newGetRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRuleResponse
newGetRuleResponse :: Int -> GetRuleResponse
newGetRuleResponse Int
pHttpStatus_ =
  GetRuleResponse'
    { $sel:description:GetRuleResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:identifier:GetRuleResponse' :: Maybe Text
identifier = forall a. Maybe a
Prelude.Nothing,
      $sel:lockConfiguration:GetRuleResponse' :: Maybe LockConfiguration
lockConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:lockEndTime:GetRuleResponse' :: Maybe POSIX
lockEndTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lockState:GetRuleResponse' :: Maybe LockState
lockState = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceTags:GetRuleResponse' :: Maybe [ResourceTag]
resourceTags = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:GetRuleResponse' :: Maybe ResourceType
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:GetRuleResponse' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetRuleResponse' :: Maybe RuleStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

-- | 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.
getRuleResponse_lockEndTime :: Lens.Lens' GetRuleResponse (Prelude.Maybe Prelude.UTCTime)
getRuleResponse_lockEndTime :: Lens' GetRuleResponse (Maybe UTCTime)
getRuleResponse_lockEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRuleResponse' {Maybe POSIX
lockEndTime :: Maybe POSIX
$sel:lockEndTime:GetRuleResponse' :: GetRuleResponse -> Maybe POSIX
lockEndTime} -> Maybe POSIX
lockEndTime) (\s :: GetRuleResponse
s@GetRuleResponse' {} Maybe POSIX
a -> GetRuleResponse
s {$sel:lockEndTime:GetRuleResponse' :: Maybe POSIX
lockEndTime = Maybe POSIX
a} :: GetRuleResponse) 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@.
getRuleResponse_lockState :: Lens.Lens' GetRuleResponse (Prelude.Maybe LockState)
getRuleResponse_lockState :: Lens' GetRuleResponse (Maybe LockState)
getRuleResponse_lockState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRuleResponse' {Maybe LockState
lockState :: Maybe LockState
$sel:lockState:GetRuleResponse' :: GetRuleResponse -> Maybe LockState
lockState} -> Maybe LockState
lockState) (\s :: GetRuleResponse
s@GetRuleResponse' {} Maybe LockState
a -> GetRuleResponse
s {$sel:lockState:GetRuleResponse' :: Maybe LockState
lockState = Maybe LockState
a} :: GetRuleResponse)

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

-- | Information about the retention period for which the retention rule is
-- to retain resources.
getRuleResponse_retentionPeriod :: Lens.Lens' GetRuleResponse (Prelude.Maybe RetentionPeriod)
getRuleResponse_retentionPeriod :: Lens' GetRuleResponse (Maybe RetentionPeriod)
getRuleResponse_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRuleResponse' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:GetRuleResponse' :: GetRuleResponse -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: GetRuleResponse
s@GetRuleResponse' {} Maybe RetentionPeriod
a -> GetRuleResponse
s {$sel:retentionPeriod:GetRuleResponse' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: GetRuleResponse)

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

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

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