{-# 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.SecretsManager.DescribeSecret
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the details of a secret. It does not include the encrypted
-- secret value. Secrets Manager only returns fields that have a value in
-- the response.
--
-- Secrets Manager generates a CloudTrail log entry when you call this
-- action. Do not include sensitive information in request parameters
-- because it might be logged. For more information, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/retrieve-ct-entries.html Logging Secrets Manager events with CloudTrail>.
--
-- __Required permissions:__ @secretsmanager:DescribeSecret@. For more
-- information, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/reference_iam-permissions.html#reference_iam-permissions_actions IAM policy actions for Secrets Manager>
-- and
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/auth-and-access.html Authentication and access control in Secrets Manager>.
module Amazonka.SecretsManager.DescribeSecret
  ( -- * Creating a Request
    DescribeSecret (..),
    newDescribeSecret,

    -- * Request Lenses
    describeSecret_secretId,

    -- * Destructuring the Response
    DescribeSecretResponse (..),
    newDescribeSecretResponse,

    -- * Response Lenses
    describeSecretResponse_arn,
    describeSecretResponse_createdDate,
    describeSecretResponse_deletedDate,
    describeSecretResponse_description,
    describeSecretResponse_kmsKeyId,
    describeSecretResponse_lastAccessedDate,
    describeSecretResponse_lastChangedDate,
    describeSecretResponse_lastRotatedDate,
    describeSecretResponse_name,
    describeSecretResponse_nextRotationDate,
    describeSecretResponse_owningService,
    describeSecretResponse_primaryRegion,
    describeSecretResponse_replicationStatus,
    describeSecretResponse_rotationEnabled,
    describeSecretResponse_rotationLambdaARN,
    describeSecretResponse_rotationRules,
    describeSecretResponse_tags,
    describeSecretResponse_versionIdsToStages,
    describeSecretResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SecretsManager.Types

-- | /See:/ 'newDescribeSecret' smart constructor.
data DescribeSecret = DescribeSecret'
  { -- | The ARN or name of the secret.
    --
    -- For an ARN, we recommend that you specify a complete ARN rather than a
    -- partial ARN. See
    -- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/troubleshoot.html#ARN_secretnamehyphen Finding a secret from a partial ARN>.
    DescribeSecret -> Text
secretId :: Prelude.Text
  }
  deriving (DescribeSecret -> DescribeSecret -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSecret -> DescribeSecret -> Bool
$c/= :: DescribeSecret -> DescribeSecret -> Bool
== :: DescribeSecret -> DescribeSecret -> Bool
$c== :: DescribeSecret -> DescribeSecret -> Bool
Prelude.Eq, ReadPrec [DescribeSecret]
ReadPrec DescribeSecret
Int -> ReadS DescribeSecret
ReadS [DescribeSecret]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSecret]
$creadListPrec :: ReadPrec [DescribeSecret]
readPrec :: ReadPrec DescribeSecret
$creadPrec :: ReadPrec DescribeSecret
readList :: ReadS [DescribeSecret]
$creadList :: ReadS [DescribeSecret]
readsPrec :: Int -> ReadS DescribeSecret
$creadsPrec :: Int -> ReadS DescribeSecret
Prelude.Read, Int -> DescribeSecret -> ShowS
[DescribeSecret] -> ShowS
DescribeSecret -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSecret] -> ShowS
$cshowList :: [DescribeSecret] -> ShowS
show :: DescribeSecret -> String
$cshow :: DescribeSecret -> String
showsPrec :: Int -> DescribeSecret -> ShowS
$cshowsPrec :: Int -> DescribeSecret -> ShowS
Prelude.Show, forall x. Rep DescribeSecret x -> DescribeSecret
forall x. DescribeSecret -> Rep DescribeSecret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeSecret x -> DescribeSecret
$cfrom :: forall x. DescribeSecret -> Rep DescribeSecret x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSecret' 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:
--
-- 'secretId', 'describeSecret_secretId' - The ARN or name of the secret.
--
-- For an ARN, we recommend that you specify a complete ARN rather than a
-- partial ARN. See
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/troubleshoot.html#ARN_secretnamehyphen Finding a secret from a partial ARN>.
newDescribeSecret ::
  -- | 'secretId'
  Prelude.Text ->
  DescribeSecret
newDescribeSecret :: Text -> DescribeSecret
newDescribeSecret Text
pSecretId_ =
  DescribeSecret' {$sel:secretId:DescribeSecret' :: Text
secretId = Text
pSecretId_}

-- | The ARN or name of the secret.
--
-- For an ARN, we recommend that you specify a complete ARN rather than a
-- partial ARN. See
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/troubleshoot.html#ARN_secretnamehyphen Finding a secret from a partial ARN>.
describeSecret_secretId :: Lens.Lens' DescribeSecret Prelude.Text
describeSecret_secretId :: Lens' DescribeSecret Text
describeSecret_secretId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecret' {Text
secretId :: Text
$sel:secretId:DescribeSecret' :: DescribeSecret -> Text
secretId} -> Text
secretId) (\s :: DescribeSecret
s@DescribeSecret' {} Text
a -> DescribeSecret
s {$sel:secretId:DescribeSecret' :: Text
secretId = Text
a} :: DescribeSecret)

instance Core.AWSRequest DescribeSecret where
  type
    AWSResponse DescribeSecret =
      DescribeSecretResponse
  request :: (Service -> Service) -> DescribeSecret -> Request DescribeSecret
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeSecret
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeSecret)))
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 POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe [ReplicationStatusType]
-> Maybe Bool
-> Maybe Text
-> Maybe RotationRulesType
-> Maybe [Tag]
-> Maybe (HashMap Text (NonEmpty Text))
-> Int
-> DescribeSecretResponse
DescribeSecretResponse'
            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
"ARN")
            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
"CreatedDate")
            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
"DeletedDate")
            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
"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
"KmsKeyId")
            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
"LastAccessedDate")
            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
"LastChangedDate")
            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
"LastRotatedDate")
            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
"Name")
            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
"NextRotationDate")
            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
"OwningService")
            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
"PrimaryRegion")
            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
"ReplicationStatus"
                            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
"RotationEnabled")
            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
"RotationLambdaARN")
            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
"RotationRules")
            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
"Tags" 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
"VersionIdsToStages"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DescribeSecret where
  hashWithSalt :: Int -> DescribeSecret -> Int
hashWithSalt Int
_salt DescribeSecret' {Text
secretId :: Text
$sel:secretId:DescribeSecret' :: DescribeSecret -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
secretId

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

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

instance Data.ToJSON DescribeSecret where
  toJSON :: DescribeSecret -> Value
toJSON DescribeSecret' {Text
secretId :: Text
$sel:secretId:DescribeSecret' :: DescribeSecret -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"SecretId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
secretId)]
      )

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

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

-- | /See:/ 'newDescribeSecretResponse' smart constructor.
data DescribeSecretResponse = DescribeSecretResponse'
  { -- | The ARN of the secret.
    DescribeSecretResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The date the secret was created.
    DescribeSecretResponse -> Maybe POSIX
createdDate :: Prelude.Maybe Data.POSIX,
    -- | The date the secret is scheduled for deletion. If it is not scheduled
    -- for deletion, this field is omitted. When you delete a secret, Secrets
    -- Manager requires a recovery window of at least 7 days before deleting
    -- the secret. Some time after the deleted date, Secrets Manager deletes
    -- the secret, including all of its versions.
    --
    -- If a secret is scheduled for deletion, then its details, including the
    -- encrypted secret value, is not accessible. To cancel a scheduled
    -- deletion and restore access to the secret, use RestoreSecret.
    DescribeSecretResponse -> Maybe POSIX
deletedDate :: Prelude.Maybe Data.POSIX,
    -- | The description of the secret.
    DescribeSecretResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The key ID or alias ARN of the KMS key that Secrets Manager uses to
    -- encrypt the secret value. If the secret is encrypted with the Amazon Web
    -- Services managed key @aws\/secretsmanager@, this field is omitted.
    -- Secrets created using the console use an KMS key ID.
    DescribeSecretResponse -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The date that the secret was last accessed in the Region. This field is
    -- omitted if the secret has never been retrieved in the Region.
    DescribeSecretResponse -> Maybe POSIX
lastAccessedDate :: Prelude.Maybe Data.POSIX,
    -- | The last date and time that this secret was modified in any way.
    DescribeSecretResponse -> Maybe POSIX
lastChangedDate :: Prelude.Maybe Data.POSIX,
    -- | The last date and time that Secrets Manager rotated the secret. If the
    -- secret isn\'t configured for rotation, Secrets Manager returns null.
    DescribeSecretResponse -> Maybe POSIX
lastRotatedDate :: Prelude.Maybe Data.POSIX,
    -- | The name of the secret.
    DescribeSecretResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    DescribeSecretResponse -> Maybe POSIX
nextRotationDate :: Prelude.Maybe Data.POSIX,
    -- | The ID of the service that created this secret. For more information,
    -- see
    -- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/service-linked-secrets.html Secrets managed by other Amazon Web Services services>.
    DescribeSecretResponse -> Maybe Text
owningService :: Prelude.Maybe Prelude.Text,
    -- | The Region the secret is in. If a secret is replicated to other Regions,
    -- the replicas are listed in @ReplicationStatus@.
    DescribeSecretResponse -> Maybe Text
primaryRegion :: Prelude.Maybe Prelude.Text,
    -- | A list of the replicas of this secret and their status:
    --
    -- -   @Failed@, which indicates that the replica was not created.
    --
    -- -   @InProgress@, which indicates that Secrets Manager is in the process
    --     of creating the replica.
    --
    -- -   @InSync@, which indicates that the replica was created.
    DescribeSecretResponse -> Maybe [ReplicationStatusType]
replicationStatus :: Prelude.Maybe [ReplicationStatusType],
    -- | Specifies whether automatic rotation is turned on for this secret.
    --
    -- To turn on rotation, use RotateSecret. To turn off rotation, use
    -- CancelRotateSecret.
    DescribeSecretResponse -> Maybe Bool
rotationEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The ARN of the Lambda function that Secrets Manager invokes to rotate
    -- the secret.
    DescribeSecretResponse -> Maybe Text
rotationLambdaARN :: Prelude.Maybe Prelude.Text,
    -- | The rotation schedule and Lambda function for this secret. If the secret
    -- previously had rotation turned on, but it is now turned off, this field
    -- shows the previous rotation schedule and rotation function. If the
    -- secret never had rotation turned on, this field is omitted.
    DescribeSecretResponse -> Maybe RotationRulesType
rotationRules :: Prelude.Maybe RotationRulesType,
    -- | The list of tags attached to the secret. To add tags to a secret, use
    -- TagResource. To remove tags, use UntagResource.
    DescribeSecretResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A list of the versions of the secret that have staging labels attached.
    -- Versions that don\'t have staging labels are considered deprecated and
    -- Secrets Manager can delete them.
    --
    -- Secrets Manager uses staging labels to indicate the status of a secret
    -- version during rotation. The three staging labels for rotation are:
    --
    -- -   @AWSCURRENT@, which indicates the current version of the secret.
    --
    -- -   @AWSPENDING@, which indicates the version of the secret that
    --     contains new secret information that will become the next current
    --     version when rotation finishes.
    --
    --     During rotation, Secrets Manager creates an @AWSPENDING@ version ID
    --     before creating the new secret version. To check if a secret version
    --     exists, call GetSecretValue.
    --
    -- -   @AWSPREVIOUS@, which indicates the previous current version of the
    --     secret. You can use this as the /last known good/ version.
    --
    -- For more information about rotation and staging labels, see
    -- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/rotate-secrets_how.html How rotation works>.
    DescribeSecretResponse -> Maybe (HashMap Text (NonEmpty Text))
versionIdsToStages :: Prelude.Maybe (Prelude.HashMap Prelude.Text (Prelude.NonEmpty Prelude.Text)),
    -- | The response's http status code.
    DescribeSecretResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeSecretResponse -> DescribeSecretResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSecretResponse -> DescribeSecretResponse -> Bool
$c/= :: DescribeSecretResponse -> DescribeSecretResponse -> Bool
== :: DescribeSecretResponse -> DescribeSecretResponse -> Bool
$c== :: DescribeSecretResponse -> DescribeSecretResponse -> Bool
Prelude.Eq, ReadPrec [DescribeSecretResponse]
ReadPrec DescribeSecretResponse
Int -> ReadS DescribeSecretResponse
ReadS [DescribeSecretResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSecretResponse]
$creadListPrec :: ReadPrec [DescribeSecretResponse]
readPrec :: ReadPrec DescribeSecretResponse
$creadPrec :: ReadPrec DescribeSecretResponse
readList :: ReadS [DescribeSecretResponse]
$creadList :: ReadS [DescribeSecretResponse]
readsPrec :: Int -> ReadS DescribeSecretResponse
$creadsPrec :: Int -> ReadS DescribeSecretResponse
Prelude.Read, Int -> DescribeSecretResponse -> ShowS
[DescribeSecretResponse] -> ShowS
DescribeSecretResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSecretResponse] -> ShowS
$cshowList :: [DescribeSecretResponse] -> ShowS
show :: DescribeSecretResponse -> String
$cshow :: DescribeSecretResponse -> String
showsPrec :: Int -> DescribeSecretResponse -> ShowS
$cshowsPrec :: Int -> DescribeSecretResponse -> ShowS
Prelude.Show, forall x. Rep DescribeSecretResponse x -> DescribeSecretResponse
forall x. DescribeSecretResponse -> Rep DescribeSecretResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeSecretResponse x -> DescribeSecretResponse
$cfrom :: forall x. DescribeSecretResponse -> Rep DescribeSecretResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSecretResponse' 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:
--
-- 'arn', 'describeSecretResponse_arn' - The ARN of the secret.
--
-- 'createdDate', 'describeSecretResponse_createdDate' - The date the secret was created.
--
-- 'deletedDate', 'describeSecretResponse_deletedDate' - The date the secret is scheduled for deletion. If it is not scheduled
-- for deletion, this field is omitted. When you delete a secret, Secrets
-- Manager requires a recovery window of at least 7 days before deleting
-- the secret. Some time after the deleted date, Secrets Manager deletes
-- the secret, including all of its versions.
--
-- If a secret is scheduled for deletion, then its details, including the
-- encrypted secret value, is not accessible. To cancel a scheduled
-- deletion and restore access to the secret, use RestoreSecret.
--
-- 'description', 'describeSecretResponse_description' - The description of the secret.
--
-- 'kmsKeyId', 'describeSecretResponse_kmsKeyId' - The key ID or alias ARN of the KMS key that Secrets Manager uses to
-- encrypt the secret value. If the secret is encrypted with the Amazon Web
-- Services managed key @aws\/secretsmanager@, this field is omitted.
-- Secrets created using the console use an KMS key ID.
--
-- 'lastAccessedDate', 'describeSecretResponse_lastAccessedDate' - The date that the secret was last accessed in the Region. This field is
-- omitted if the secret has never been retrieved in the Region.
--
-- 'lastChangedDate', 'describeSecretResponse_lastChangedDate' - The last date and time that this secret was modified in any way.
--
-- 'lastRotatedDate', 'describeSecretResponse_lastRotatedDate' - The last date and time that Secrets Manager rotated the secret. If the
-- secret isn\'t configured for rotation, Secrets Manager returns null.
--
-- 'name', 'describeSecretResponse_name' - The name of the secret.
--
-- 'nextRotationDate', 'describeSecretResponse_nextRotationDate' - Undocumented member.
--
-- 'owningService', 'describeSecretResponse_owningService' - The ID of the service that created this secret. For more information,
-- see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/service-linked-secrets.html Secrets managed by other Amazon Web Services services>.
--
-- 'primaryRegion', 'describeSecretResponse_primaryRegion' - The Region the secret is in. If a secret is replicated to other Regions,
-- the replicas are listed in @ReplicationStatus@.
--
-- 'replicationStatus', 'describeSecretResponse_replicationStatus' - A list of the replicas of this secret and their status:
--
-- -   @Failed@, which indicates that the replica was not created.
--
-- -   @InProgress@, which indicates that Secrets Manager is in the process
--     of creating the replica.
--
-- -   @InSync@, which indicates that the replica was created.
--
-- 'rotationEnabled', 'describeSecretResponse_rotationEnabled' - Specifies whether automatic rotation is turned on for this secret.
--
-- To turn on rotation, use RotateSecret. To turn off rotation, use
-- CancelRotateSecret.
--
-- 'rotationLambdaARN', 'describeSecretResponse_rotationLambdaARN' - The ARN of the Lambda function that Secrets Manager invokes to rotate
-- the secret.
--
-- 'rotationRules', 'describeSecretResponse_rotationRules' - The rotation schedule and Lambda function for this secret. If the secret
-- previously had rotation turned on, but it is now turned off, this field
-- shows the previous rotation schedule and rotation function. If the
-- secret never had rotation turned on, this field is omitted.
--
-- 'tags', 'describeSecretResponse_tags' - The list of tags attached to the secret. To add tags to a secret, use
-- TagResource. To remove tags, use UntagResource.
--
-- 'versionIdsToStages', 'describeSecretResponse_versionIdsToStages' - A list of the versions of the secret that have staging labels attached.
-- Versions that don\'t have staging labels are considered deprecated and
-- Secrets Manager can delete them.
--
-- Secrets Manager uses staging labels to indicate the status of a secret
-- version during rotation. The three staging labels for rotation are:
--
-- -   @AWSCURRENT@, which indicates the current version of the secret.
--
-- -   @AWSPENDING@, which indicates the version of the secret that
--     contains new secret information that will become the next current
--     version when rotation finishes.
--
--     During rotation, Secrets Manager creates an @AWSPENDING@ version ID
--     before creating the new secret version. To check if a secret version
--     exists, call GetSecretValue.
--
-- -   @AWSPREVIOUS@, which indicates the previous current version of the
--     secret. You can use this as the /last known good/ version.
--
-- For more information about rotation and staging labels, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/rotate-secrets_how.html How rotation works>.
--
-- 'httpStatus', 'describeSecretResponse_httpStatus' - The response's http status code.
newDescribeSecretResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeSecretResponse
newDescribeSecretResponse :: Int -> DescribeSecretResponse
newDescribeSecretResponse Int
pHttpStatus_ =
  DescribeSecretResponse'
    { $sel:arn:DescribeSecretResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdDate:DescribeSecretResponse' :: Maybe POSIX
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:deletedDate:DescribeSecretResponse' :: Maybe POSIX
deletedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeSecretResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:DescribeSecretResponse' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:lastAccessedDate:DescribeSecretResponse' :: Maybe POSIX
lastAccessedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:lastChangedDate:DescribeSecretResponse' :: Maybe POSIX
lastChangedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:lastRotatedDate:DescribeSecretResponse' :: Maybe POSIX
lastRotatedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeSecretResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:nextRotationDate:DescribeSecretResponse' :: Maybe POSIX
nextRotationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:owningService:DescribeSecretResponse' :: Maybe Text
owningService = forall a. Maybe a
Prelude.Nothing,
      $sel:primaryRegion:DescribeSecretResponse' :: Maybe Text
primaryRegion = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationStatus:DescribeSecretResponse' :: Maybe [ReplicationStatusType]
replicationStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:rotationEnabled:DescribeSecretResponse' :: Maybe Bool
rotationEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:rotationLambdaARN:DescribeSecretResponse' :: Maybe Text
rotationLambdaARN = forall a. Maybe a
Prelude.Nothing,
      $sel:rotationRules:DescribeSecretResponse' :: Maybe RotationRulesType
rotationRules = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribeSecretResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:versionIdsToStages:DescribeSecretResponse' :: Maybe (HashMap Text (NonEmpty Text))
versionIdsToStages = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeSecretResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the secret.
describeSecretResponse_arn :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Text)
describeSecretResponse_arn :: Lens' DescribeSecretResponse (Maybe Text)
describeSecretResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Text
a -> DescribeSecretResponse
s {$sel:arn:DescribeSecretResponse' :: Maybe Text
arn = Maybe Text
a} :: DescribeSecretResponse)

-- | The date the secret was created.
describeSecretResponse_createdDate :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.UTCTime)
describeSecretResponse_createdDate :: Lens' DescribeSecretResponse (Maybe UTCTime)
describeSecretResponse_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe POSIX
createdDate :: Maybe POSIX
$sel:createdDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
createdDate} -> Maybe POSIX
createdDate) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe POSIX
a -> DescribeSecretResponse
s {$sel:createdDate:DescribeSecretResponse' :: Maybe POSIX
createdDate = Maybe POSIX
a} :: DescribeSecretResponse) 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 date the secret is scheduled for deletion. If it is not scheduled
-- for deletion, this field is omitted. When you delete a secret, Secrets
-- Manager requires a recovery window of at least 7 days before deleting
-- the secret. Some time after the deleted date, Secrets Manager deletes
-- the secret, including all of its versions.
--
-- If a secret is scheduled for deletion, then its details, including the
-- encrypted secret value, is not accessible. To cancel a scheduled
-- deletion and restore access to the secret, use RestoreSecret.
describeSecretResponse_deletedDate :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.UTCTime)
describeSecretResponse_deletedDate :: Lens' DescribeSecretResponse (Maybe UTCTime)
describeSecretResponse_deletedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe POSIX
deletedDate :: Maybe POSIX
$sel:deletedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
deletedDate} -> Maybe POSIX
deletedDate) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe POSIX
a -> DescribeSecretResponse
s {$sel:deletedDate:DescribeSecretResponse' :: Maybe POSIX
deletedDate = Maybe POSIX
a} :: DescribeSecretResponse) 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 description of the secret.
describeSecretResponse_description :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Text)
describeSecretResponse_description :: Lens' DescribeSecretResponse (Maybe Text)
describeSecretResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Text
a -> DescribeSecretResponse
s {$sel:description:DescribeSecretResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeSecretResponse)

-- | The key ID or alias ARN of the KMS key that Secrets Manager uses to
-- encrypt the secret value. If the secret is encrypted with the Amazon Web
-- Services managed key @aws\/secretsmanager@, this field is omitted.
-- Secrets created using the console use an KMS key ID.
describeSecretResponse_kmsKeyId :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Text)
describeSecretResponse_kmsKeyId :: Lens' DescribeSecretResponse (Maybe Text)
describeSecretResponse_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Text
a -> DescribeSecretResponse
s {$sel:kmsKeyId:DescribeSecretResponse' :: Maybe Text
kmsKeyId = Maybe Text
a} :: DescribeSecretResponse)

-- | The date that the secret was last accessed in the Region. This field is
-- omitted if the secret has never been retrieved in the Region.
describeSecretResponse_lastAccessedDate :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.UTCTime)
describeSecretResponse_lastAccessedDate :: Lens' DescribeSecretResponse (Maybe UTCTime)
describeSecretResponse_lastAccessedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe POSIX
lastAccessedDate :: Maybe POSIX
$sel:lastAccessedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
lastAccessedDate} -> Maybe POSIX
lastAccessedDate) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe POSIX
a -> DescribeSecretResponse
s {$sel:lastAccessedDate:DescribeSecretResponse' :: Maybe POSIX
lastAccessedDate = Maybe POSIX
a} :: DescribeSecretResponse) 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 last date and time that this secret was modified in any way.
describeSecretResponse_lastChangedDate :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.UTCTime)
describeSecretResponse_lastChangedDate :: Lens' DescribeSecretResponse (Maybe UTCTime)
describeSecretResponse_lastChangedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe POSIX
lastChangedDate :: Maybe POSIX
$sel:lastChangedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
lastChangedDate} -> Maybe POSIX
lastChangedDate) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe POSIX
a -> DescribeSecretResponse
s {$sel:lastChangedDate:DescribeSecretResponse' :: Maybe POSIX
lastChangedDate = Maybe POSIX
a} :: DescribeSecretResponse) 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 last date and time that Secrets Manager rotated the secret. If the
-- secret isn\'t configured for rotation, Secrets Manager returns null.
describeSecretResponse_lastRotatedDate :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.UTCTime)
describeSecretResponse_lastRotatedDate :: Lens' DescribeSecretResponse (Maybe UTCTime)
describeSecretResponse_lastRotatedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe POSIX
lastRotatedDate :: Maybe POSIX
$sel:lastRotatedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
lastRotatedDate} -> Maybe POSIX
lastRotatedDate) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe POSIX
a -> DescribeSecretResponse
s {$sel:lastRotatedDate:DescribeSecretResponse' :: Maybe POSIX
lastRotatedDate = Maybe POSIX
a} :: DescribeSecretResponse) 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 name of the secret.
describeSecretResponse_name :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Text)
describeSecretResponse_name :: Lens' DescribeSecretResponse (Maybe Text)
describeSecretResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Text
name :: Maybe Text
$sel:name:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Text
a -> DescribeSecretResponse
s {$sel:name:DescribeSecretResponse' :: Maybe Text
name = Maybe Text
a} :: DescribeSecretResponse)

-- | Undocumented member.
describeSecretResponse_nextRotationDate :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.UTCTime)
describeSecretResponse_nextRotationDate :: Lens' DescribeSecretResponse (Maybe UTCTime)
describeSecretResponse_nextRotationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe POSIX
nextRotationDate :: Maybe POSIX
$sel:nextRotationDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
nextRotationDate} -> Maybe POSIX
nextRotationDate) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe POSIX
a -> DescribeSecretResponse
s {$sel:nextRotationDate:DescribeSecretResponse' :: Maybe POSIX
nextRotationDate = Maybe POSIX
a} :: DescribeSecretResponse) 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 ID of the service that created this secret. For more information,
-- see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/service-linked-secrets.html Secrets managed by other Amazon Web Services services>.
describeSecretResponse_owningService :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Text)
describeSecretResponse_owningService :: Lens' DescribeSecretResponse (Maybe Text)
describeSecretResponse_owningService = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Text
owningService :: Maybe Text
$sel:owningService:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
owningService} -> Maybe Text
owningService) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Text
a -> DescribeSecretResponse
s {$sel:owningService:DescribeSecretResponse' :: Maybe Text
owningService = Maybe Text
a} :: DescribeSecretResponse)

-- | The Region the secret is in. If a secret is replicated to other Regions,
-- the replicas are listed in @ReplicationStatus@.
describeSecretResponse_primaryRegion :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Text)
describeSecretResponse_primaryRegion :: Lens' DescribeSecretResponse (Maybe Text)
describeSecretResponse_primaryRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Text
primaryRegion :: Maybe Text
$sel:primaryRegion:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
primaryRegion} -> Maybe Text
primaryRegion) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Text
a -> DescribeSecretResponse
s {$sel:primaryRegion:DescribeSecretResponse' :: Maybe Text
primaryRegion = Maybe Text
a} :: DescribeSecretResponse)

-- | A list of the replicas of this secret and their status:
--
-- -   @Failed@, which indicates that the replica was not created.
--
-- -   @InProgress@, which indicates that Secrets Manager is in the process
--     of creating the replica.
--
-- -   @InSync@, which indicates that the replica was created.
describeSecretResponse_replicationStatus :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe [ReplicationStatusType])
describeSecretResponse_replicationStatus :: Lens' DescribeSecretResponse (Maybe [ReplicationStatusType])
describeSecretResponse_replicationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe [ReplicationStatusType]
replicationStatus :: Maybe [ReplicationStatusType]
$sel:replicationStatus:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe [ReplicationStatusType]
replicationStatus} -> Maybe [ReplicationStatusType]
replicationStatus) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe [ReplicationStatusType]
a -> DescribeSecretResponse
s {$sel:replicationStatus:DescribeSecretResponse' :: Maybe [ReplicationStatusType]
replicationStatus = Maybe [ReplicationStatusType]
a} :: DescribeSecretResponse) 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

-- | Specifies whether automatic rotation is turned on for this secret.
--
-- To turn on rotation, use RotateSecret. To turn off rotation, use
-- CancelRotateSecret.
describeSecretResponse_rotationEnabled :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Bool)
describeSecretResponse_rotationEnabled :: Lens' DescribeSecretResponse (Maybe Bool)
describeSecretResponse_rotationEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Bool
rotationEnabled :: Maybe Bool
$sel:rotationEnabled:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Bool
rotationEnabled} -> Maybe Bool
rotationEnabled) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Bool
a -> DescribeSecretResponse
s {$sel:rotationEnabled:DescribeSecretResponse' :: Maybe Bool
rotationEnabled = Maybe Bool
a} :: DescribeSecretResponse)

-- | The ARN of the Lambda function that Secrets Manager invokes to rotate
-- the secret.
describeSecretResponse_rotationLambdaARN :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe Prelude.Text)
describeSecretResponse_rotationLambdaARN :: Lens' DescribeSecretResponse (Maybe Text)
describeSecretResponse_rotationLambdaARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe Text
rotationLambdaARN :: Maybe Text
$sel:rotationLambdaARN:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
rotationLambdaARN} -> Maybe Text
rotationLambdaARN) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe Text
a -> DescribeSecretResponse
s {$sel:rotationLambdaARN:DescribeSecretResponse' :: Maybe Text
rotationLambdaARN = Maybe Text
a} :: DescribeSecretResponse)

-- | The rotation schedule and Lambda function for this secret. If the secret
-- previously had rotation turned on, but it is now turned off, this field
-- shows the previous rotation schedule and rotation function. If the
-- secret never had rotation turned on, this field is omitted.
describeSecretResponse_rotationRules :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe RotationRulesType)
describeSecretResponse_rotationRules :: Lens' DescribeSecretResponse (Maybe RotationRulesType)
describeSecretResponse_rotationRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe RotationRulesType
rotationRules :: Maybe RotationRulesType
$sel:rotationRules:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe RotationRulesType
rotationRules} -> Maybe RotationRulesType
rotationRules) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe RotationRulesType
a -> DescribeSecretResponse
s {$sel:rotationRules:DescribeSecretResponse' :: Maybe RotationRulesType
rotationRules = Maybe RotationRulesType
a} :: DescribeSecretResponse)

-- | The list of tags attached to the secret. To add tags to a secret, use
-- TagResource. To remove tags, use UntagResource.
describeSecretResponse_tags :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe [Tag])
describeSecretResponse_tags :: Lens' DescribeSecretResponse (Maybe [Tag])
describeSecretResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe [Tag]
a -> DescribeSecretResponse
s {$sel:tags:DescribeSecretResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: DescribeSecretResponse) 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

-- | A list of the versions of the secret that have staging labels attached.
-- Versions that don\'t have staging labels are considered deprecated and
-- Secrets Manager can delete them.
--
-- Secrets Manager uses staging labels to indicate the status of a secret
-- version during rotation. The three staging labels for rotation are:
--
-- -   @AWSCURRENT@, which indicates the current version of the secret.
--
-- -   @AWSPENDING@, which indicates the version of the secret that
--     contains new secret information that will become the next current
--     version when rotation finishes.
--
--     During rotation, Secrets Manager creates an @AWSPENDING@ version ID
--     before creating the new secret version. To check if a secret version
--     exists, call GetSecretValue.
--
-- -   @AWSPREVIOUS@, which indicates the previous current version of the
--     secret. You can use this as the /last known good/ version.
--
-- For more information about rotation and staging labels, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/rotate-secrets_how.html How rotation works>.
describeSecretResponse_versionIdsToStages :: Lens.Lens' DescribeSecretResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text (Prelude.NonEmpty Prelude.Text)))
describeSecretResponse_versionIdsToStages :: Lens' DescribeSecretResponse (Maybe (HashMap Text (NonEmpty Text)))
describeSecretResponse_versionIdsToStages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Maybe (HashMap Text (NonEmpty Text))
versionIdsToStages :: Maybe (HashMap Text (NonEmpty Text))
$sel:versionIdsToStages:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe (HashMap Text (NonEmpty Text))
versionIdsToStages} -> Maybe (HashMap Text (NonEmpty Text))
versionIdsToStages) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Maybe (HashMap Text (NonEmpty Text))
a -> DescribeSecretResponse
s {$sel:versionIdsToStages:DescribeSecretResponse' :: Maybe (HashMap Text (NonEmpty Text))
versionIdsToStages = Maybe (HashMap Text (NonEmpty Text))
a} :: DescribeSecretResponse) 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 response's http status code.
describeSecretResponse_httpStatus :: Lens.Lens' DescribeSecretResponse Prelude.Int
describeSecretResponse_httpStatus :: Lens' DescribeSecretResponse Int
describeSecretResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecretResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeSecretResponse' :: DescribeSecretResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeSecretResponse
s@DescribeSecretResponse' {} Int
a -> DescribeSecretResponse
s {$sel:httpStatus:DescribeSecretResponse' :: Int
httpStatus = Int
a} :: DescribeSecretResponse)

instance Prelude.NFData DescribeSecretResponse where
  rnf :: DescribeSecretResponse -> ()
rnf DescribeSecretResponse' {Int
Maybe Bool
Maybe [ReplicationStatusType]
Maybe [Tag]
Maybe Text
Maybe (HashMap Text (NonEmpty Text))
Maybe POSIX
Maybe RotationRulesType
httpStatus :: Int
versionIdsToStages :: Maybe (HashMap Text (NonEmpty Text))
tags :: Maybe [Tag]
rotationRules :: Maybe RotationRulesType
rotationLambdaARN :: Maybe Text
rotationEnabled :: Maybe Bool
replicationStatus :: Maybe [ReplicationStatusType]
primaryRegion :: Maybe Text
owningService :: Maybe Text
nextRotationDate :: Maybe POSIX
name :: Maybe Text
lastRotatedDate :: Maybe POSIX
lastChangedDate :: Maybe POSIX
lastAccessedDate :: Maybe POSIX
kmsKeyId :: Maybe Text
description :: Maybe Text
deletedDate :: Maybe POSIX
createdDate :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:DescribeSecretResponse' :: DescribeSecretResponse -> Int
$sel:versionIdsToStages:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe (HashMap Text (NonEmpty Text))
$sel:tags:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe [Tag]
$sel:rotationRules:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe RotationRulesType
$sel:rotationLambdaARN:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
$sel:rotationEnabled:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Bool
$sel:replicationStatus:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe [ReplicationStatusType]
$sel:primaryRegion:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
$sel:owningService:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
$sel:nextRotationDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
$sel:name:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
$sel:lastRotatedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
$sel:lastChangedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
$sel:lastAccessedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
$sel:kmsKeyId:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
$sel:description:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
$sel:deletedDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
$sel:createdDate:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe POSIX
$sel:arn:DescribeSecretResponse' :: DescribeSecretResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
deletedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastAccessedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastChangedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastRotatedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
nextRotationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
owningService
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
primaryRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ReplicationStatusType]
replicationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
rotationEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
rotationLambdaARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RotationRulesType
rotationRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text (NonEmpty Text))
versionIdsToStages
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus