{-# 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.UpdateSecretVersionStage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the staging labels attached to a version of a secret. Secrets
-- Manager uses staging labels to track a version as it progresses through
-- the secret rotation process. Each staging label can be attached to only
-- one version at a time. To add a staging label to a version when it is
-- already attached to another version, Secrets Manager first removes it
-- from the other version first and then attaches it to this one. For more
-- information about versions and staging labels, see
-- <https://docs.aws.amazon.com/secretsmanager/latest/userguide/getting-started.html#term_version Concepts: Version>.
--
-- The staging labels that you specify in the @VersionStage@ parameter are
-- added to the existing list of staging labels for the version.
--
-- You can move the @AWSCURRENT@ staging label to this version by including
-- it in this call.
--
-- Whenever you move @AWSCURRENT@, Secrets Manager automatically moves the
-- label @AWSPREVIOUS@ to the version that @AWSCURRENT@ was removed from.
--
-- If this action results in the last label being removed from a version,
-- then the version is considered to be \'deprecated\' and can be deleted
-- by Secrets Manager.
--
-- 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:UpdateSecretVersionStage@. 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.UpdateSecretVersionStage
  ( -- * Creating a Request
    UpdateSecretVersionStage (..),
    newUpdateSecretVersionStage,

    -- * Request Lenses
    updateSecretVersionStage_moveToVersionId,
    updateSecretVersionStage_removeFromVersionId,
    updateSecretVersionStage_secretId,
    updateSecretVersionStage_versionStage,

    -- * Destructuring the Response
    UpdateSecretVersionStageResponse (..),
    newUpdateSecretVersionStageResponse,

    -- * Response Lenses
    updateSecretVersionStageResponse_arn,
    updateSecretVersionStageResponse_name,
    updateSecretVersionStageResponse_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:/ 'newUpdateSecretVersionStage' smart constructor.
data UpdateSecretVersionStage = UpdateSecretVersionStage'
  { -- | The ID of the version to add the staging label to. To remove a label
    -- from a version, then do not specify this parameter.
    --
    -- If the staging label is already attached to a different version of the
    -- secret, then you must also specify the @RemoveFromVersionId@ parameter.
    UpdateSecretVersionStage -> Maybe Text
moveToVersionId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the version that the staging label is to be removed from. If
    -- the staging label you are trying to attach to one version is already
    -- attached to a different version, then you must include this parameter
    -- and specify the version that the label is to be removed from. If the
    -- label is attached and you either do not specify this parameter, or the
    -- version ID does not match, then the operation fails.
    UpdateSecretVersionStage -> Maybe Text
removeFromVersionId :: Prelude.Maybe Prelude.Text,
    -- | The ARN or the name of the secret with the version and staging labelsto
    -- modify.
    --
    -- 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>.
    UpdateSecretVersionStage -> Text
secretId :: Prelude.Text,
    -- | The staging label to add to this version.
    UpdateSecretVersionStage -> Text
versionStage :: Prelude.Text
  }
  deriving (UpdateSecretVersionStage -> UpdateSecretVersionStage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSecretVersionStage -> UpdateSecretVersionStage -> Bool
$c/= :: UpdateSecretVersionStage -> UpdateSecretVersionStage -> Bool
== :: UpdateSecretVersionStage -> UpdateSecretVersionStage -> Bool
$c== :: UpdateSecretVersionStage -> UpdateSecretVersionStage -> Bool
Prelude.Eq, ReadPrec [UpdateSecretVersionStage]
ReadPrec UpdateSecretVersionStage
Int -> ReadS UpdateSecretVersionStage
ReadS [UpdateSecretVersionStage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSecretVersionStage]
$creadListPrec :: ReadPrec [UpdateSecretVersionStage]
readPrec :: ReadPrec UpdateSecretVersionStage
$creadPrec :: ReadPrec UpdateSecretVersionStage
readList :: ReadS [UpdateSecretVersionStage]
$creadList :: ReadS [UpdateSecretVersionStage]
readsPrec :: Int -> ReadS UpdateSecretVersionStage
$creadsPrec :: Int -> ReadS UpdateSecretVersionStage
Prelude.Read, Int -> UpdateSecretVersionStage -> ShowS
[UpdateSecretVersionStage] -> ShowS
UpdateSecretVersionStage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSecretVersionStage] -> ShowS
$cshowList :: [UpdateSecretVersionStage] -> ShowS
show :: UpdateSecretVersionStage -> String
$cshow :: UpdateSecretVersionStage -> String
showsPrec :: Int -> UpdateSecretVersionStage -> ShowS
$cshowsPrec :: Int -> UpdateSecretVersionStage -> ShowS
Prelude.Show, forall x.
Rep UpdateSecretVersionStage x -> UpdateSecretVersionStage
forall x.
UpdateSecretVersionStage -> Rep UpdateSecretVersionStage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateSecretVersionStage x -> UpdateSecretVersionStage
$cfrom :: forall x.
UpdateSecretVersionStage -> Rep UpdateSecretVersionStage x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSecretVersionStage' 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:
--
-- 'moveToVersionId', 'updateSecretVersionStage_moveToVersionId' - The ID of the version to add the staging label to. To remove a label
-- from a version, then do not specify this parameter.
--
-- If the staging label is already attached to a different version of the
-- secret, then you must also specify the @RemoveFromVersionId@ parameter.
--
-- 'removeFromVersionId', 'updateSecretVersionStage_removeFromVersionId' - The ID of the version that the staging label is to be removed from. If
-- the staging label you are trying to attach to one version is already
-- attached to a different version, then you must include this parameter
-- and specify the version that the label is to be removed from. If the
-- label is attached and you either do not specify this parameter, or the
-- version ID does not match, then the operation fails.
--
-- 'secretId', 'updateSecretVersionStage_secretId' - The ARN or the name of the secret with the version and staging labelsto
-- modify.
--
-- 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>.
--
-- 'versionStage', 'updateSecretVersionStage_versionStage' - The staging label to add to this version.
newUpdateSecretVersionStage ::
  -- | 'secretId'
  Prelude.Text ->
  -- | 'versionStage'
  Prelude.Text ->
  UpdateSecretVersionStage
newUpdateSecretVersionStage :: Text -> Text -> UpdateSecretVersionStage
newUpdateSecretVersionStage Text
pSecretId_ Text
pVersionStage_ =
  UpdateSecretVersionStage'
    { $sel:moveToVersionId:UpdateSecretVersionStage' :: Maybe Text
moveToVersionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:removeFromVersionId:UpdateSecretVersionStage' :: Maybe Text
removeFromVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:secretId:UpdateSecretVersionStage' :: Text
secretId = Text
pSecretId_,
      $sel:versionStage:UpdateSecretVersionStage' :: Text
versionStage = Text
pVersionStage_
    }

-- | The ID of the version to add the staging label to. To remove a label
-- from a version, then do not specify this parameter.
--
-- If the staging label is already attached to a different version of the
-- secret, then you must also specify the @RemoveFromVersionId@ parameter.
updateSecretVersionStage_moveToVersionId :: Lens.Lens' UpdateSecretVersionStage (Prelude.Maybe Prelude.Text)
updateSecretVersionStage_moveToVersionId :: Lens' UpdateSecretVersionStage (Maybe Text)
updateSecretVersionStage_moveToVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecretVersionStage' {Maybe Text
moveToVersionId :: Maybe Text
$sel:moveToVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
moveToVersionId} -> Maybe Text
moveToVersionId) (\s :: UpdateSecretVersionStage
s@UpdateSecretVersionStage' {} Maybe Text
a -> UpdateSecretVersionStage
s {$sel:moveToVersionId:UpdateSecretVersionStage' :: Maybe Text
moveToVersionId = Maybe Text
a} :: UpdateSecretVersionStage)

-- | The ID of the version that the staging label is to be removed from. If
-- the staging label you are trying to attach to one version is already
-- attached to a different version, then you must include this parameter
-- and specify the version that the label is to be removed from. If the
-- label is attached and you either do not specify this parameter, or the
-- version ID does not match, then the operation fails.
updateSecretVersionStage_removeFromVersionId :: Lens.Lens' UpdateSecretVersionStage (Prelude.Maybe Prelude.Text)
updateSecretVersionStage_removeFromVersionId :: Lens' UpdateSecretVersionStage (Maybe Text)
updateSecretVersionStage_removeFromVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecretVersionStage' {Maybe Text
removeFromVersionId :: Maybe Text
$sel:removeFromVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
removeFromVersionId} -> Maybe Text
removeFromVersionId) (\s :: UpdateSecretVersionStage
s@UpdateSecretVersionStage' {} Maybe Text
a -> UpdateSecretVersionStage
s {$sel:removeFromVersionId:UpdateSecretVersionStage' :: Maybe Text
removeFromVersionId = Maybe Text
a} :: UpdateSecretVersionStage)

-- | The ARN or the name of the secret with the version and staging labelsto
-- modify.
--
-- 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>.
updateSecretVersionStage_secretId :: Lens.Lens' UpdateSecretVersionStage Prelude.Text
updateSecretVersionStage_secretId :: Lens' UpdateSecretVersionStage Text
updateSecretVersionStage_secretId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecretVersionStage' {Text
secretId :: Text
$sel:secretId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
secretId} -> Text
secretId) (\s :: UpdateSecretVersionStage
s@UpdateSecretVersionStage' {} Text
a -> UpdateSecretVersionStage
s {$sel:secretId:UpdateSecretVersionStage' :: Text
secretId = Text
a} :: UpdateSecretVersionStage)

-- | The staging label to add to this version.
updateSecretVersionStage_versionStage :: Lens.Lens' UpdateSecretVersionStage Prelude.Text
updateSecretVersionStage_versionStage :: Lens' UpdateSecretVersionStage Text
updateSecretVersionStage_versionStage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecretVersionStage' {Text
versionStage :: Text
$sel:versionStage:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
versionStage} -> Text
versionStage) (\s :: UpdateSecretVersionStage
s@UpdateSecretVersionStage' {} Text
a -> UpdateSecretVersionStage
s {$sel:versionStage:UpdateSecretVersionStage' :: Text
versionStage = Text
a} :: UpdateSecretVersionStage)

instance Core.AWSRequest UpdateSecretVersionStage where
  type
    AWSResponse UpdateSecretVersionStage =
      UpdateSecretVersionStageResponse
  request :: (Service -> Service)
-> UpdateSecretVersionStage -> Request UpdateSecretVersionStage
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 UpdateSecretVersionStage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateSecretVersionStage)))
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 -> Int -> UpdateSecretVersionStageResponse
UpdateSecretVersionStageResponse'
            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
"Name")
            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 UpdateSecretVersionStage where
  hashWithSalt :: Int -> UpdateSecretVersionStage -> Int
hashWithSalt Int
_salt UpdateSecretVersionStage' {Maybe Text
Text
versionStage :: Text
secretId :: Text
removeFromVersionId :: Maybe Text
moveToVersionId :: Maybe Text
$sel:versionStage:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
$sel:secretId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
$sel:removeFromVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
$sel:moveToVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
moveToVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
removeFromVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
secretId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
versionStage

instance Prelude.NFData UpdateSecretVersionStage where
  rnf :: UpdateSecretVersionStage -> ()
rnf UpdateSecretVersionStage' {Maybe Text
Text
versionStage :: Text
secretId :: Text
removeFromVersionId :: Maybe Text
moveToVersionId :: Maybe Text
$sel:versionStage:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
$sel:secretId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
$sel:removeFromVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
$sel:moveToVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
moveToVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
removeFromVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
secretId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
versionStage

instance Data.ToHeaders UpdateSecretVersionStage where
  toHeaders :: UpdateSecretVersionStage -> 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.UpdateSecretVersionStage" ::
                          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 UpdateSecretVersionStage where
  toJSON :: UpdateSecretVersionStage -> Value
toJSON UpdateSecretVersionStage' {Maybe Text
Text
versionStage :: Text
secretId :: Text
removeFromVersionId :: Maybe Text
moveToVersionId :: Maybe Text
$sel:versionStage:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
$sel:secretId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Text
$sel:removeFromVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
$sel:moveToVersionId:UpdateSecretVersionStage' :: UpdateSecretVersionStage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MoveToVersionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
moveToVersionId,
            (Key
"RemoveFromVersionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
removeFromVersionId,
            forall a. a -> Maybe a
Prelude.Just (Key
"SecretId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
secretId),
            forall a. a -> Maybe a
Prelude.Just (Key
"VersionStage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
versionStage)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateSecretVersionStageResponse' 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', 'updateSecretVersionStageResponse_arn' - The ARN of the secret that was updated.
--
-- 'name', 'updateSecretVersionStageResponse_name' - The name of the secret that was updated.
--
-- 'httpStatus', 'updateSecretVersionStageResponse_httpStatus' - The response's http status code.
newUpdateSecretVersionStageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSecretVersionStageResponse
newUpdateSecretVersionStageResponse :: Int -> UpdateSecretVersionStageResponse
newUpdateSecretVersionStageResponse Int
pHttpStatus_ =
  UpdateSecretVersionStageResponse'
    { $sel:arn:UpdateSecretVersionStageResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateSecretVersionStageResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateSecretVersionStageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The name of the secret that was updated.
updateSecretVersionStageResponse_name :: Lens.Lens' UpdateSecretVersionStageResponse (Prelude.Maybe Prelude.Text)
updateSecretVersionStageResponse_name :: Lens' UpdateSecretVersionStageResponse (Maybe Text)
updateSecretVersionStageResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSecretVersionStageResponse' {Maybe Text
name :: Maybe Text
$sel:name:UpdateSecretVersionStageResponse' :: UpdateSecretVersionStageResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateSecretVersionStageResponse
s@UpdateSecretVersionStageResponse' {} Maybe Text
a -> UpdateSecretVersionStageResponse
s {$sel:name:UpdateSecretVersionStageResponse' :: Maybe Text
name = Maybe Text
a} :: UpdateSecretVersionStageResponse)

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

instance
  Prelude.NFData
    UpdateSecretVersionStageResponse
  where
  rnf :: UpdateSecretVersionStageResponse -> ()
rnf UpdateSecretVersionStageResponse' {Int
Maybe Text
httpStatus :: Int
name :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:UpdateSecretVersionStageResponse' :: UpdateSecretVersionStageResponse -> Int
$sel:name:UpdateSecretVersionStageResponse' :: UpdateSecretVersionStageResponse -> Maybe Text
$sel:arn:UpdateSecretVersionStageResponse' :: UpdateSecretVersionStageResponse -> 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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus