{-# 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.PutSecretValue
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new version with a new encrypted secret value and attaches it
-- to the secret. The version can contain a new @SecretString@ value or a
-- new @SecretBinary@ value.
--
-- We recommend you avoid calling @PutSecretValue@ at a sustained rate of
-- more than once every 10 minutes. When you update the secret value,
-- Secrets Manager creates a new version of the secret. Secrets Manager
-- removes outdated versions when there are more than 100, but it does not
-- remove versions created less than 24 hours ago. If you call
-- @PutSecretValue@ more than once every 10 minutes, you create more
-- versions than Secrets Manager removes, and you will reach the quota for
-- secret versions.
--
-- You can specify the staging labels to attach to the new version in
-- @VersionStages@. If you don\'t include @VersionStages@, then Secrets
-- Manager automatically moves the staging label @AWSCURRENT@ to this
-- version. If this operation creates the first version for the secret,
-- then Secrets Manager automatically attaches the staging label
-- @AWSCURRENT@ to it. If this operation moves the staging label
-- @AWSCURRENT@ from another version to this version, then Secrets Manager
-- also automatically moves the staging label @AWSPREVIOUS@ to the version
-- that @AWSCURRENT@ was removed from.
--
-- This operation is idempotent. If you call this operation with a
-- @ClientRequestToken@ that matches an existing version\'s VersionId, and
-- you specify the same secret data, the operation succeeds but does
-- nothing. However, if the secret data is different, then the operation
-- fails because you can\'t modify an existing version; you can only create
-- new ones.
--
-- Secrets Manager generates a CloudTrail log entry when you call this
-- action. Do not include sensitive information in request parameters
-- except @SecretBinary@ or @SecretString@ 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:PutSecretValue@. 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.PutSecretValue
  ( -- * Creating a Request
    PutSecretValue (..),
    newPutSecretValue,

    -- * Request Lenses
    putSecretValue_clientRequestToken,
    putSecretValue_secretBinary,
    putSecretValue_secretString,
    putSecretValue_versionStages,
    putSecretValue_secretId,

    -- * Destructuring the Response
    PutSecretValueResponse (..),
    newPutSecretValueResponse,

    -- * Response Lenses
    putSecretValueResponse_arn,
    putSecretValueResponse_name,
    putSecretValueResponse_versionId,
    putSecretValueResponse_versionStages,
    putSecretValueResponse_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:/ 'newPutSecretValue' smart constructor.
data PutSecretValue = PutSecretValue'
  { -- | A unique identifier for the new version of the secret.
    --
    -- If you use the Amazon Web Services CLI or one of the Amazon Web Services
    -- SDKs to call this operation, then you can leave this parameter empty
    -- because they generate a random UUID for you. If you don\'t use the SDK
    -- and instead generate a raw HTTP request to the Secrets Manager service
    -- endpoint, then you must generate a @ClientRequestToken@ yourself for new
    -- versions and include that value in the request.
    --
    -- This value helps ensure idempotency. Secrets Manager uses this value to
    -- prevent the accidental creation of duplicate versions if there are
    -- failures and retries during the Lambda rotation function processing. We
    -- recommend that you generate a
    -- <https://wikipedia.org/wiki/Universally_unique_identifier UUID-type>
    -- value to ensure uniqueness within the specified secret.
    --
    -- -   If the @ClientRequestToken@ value isn\'t already associated with a
    --     version of the secret then a new version of the secret is created.
    --
    -- -   If a version with this value already exists and that version\'s
    --     @SecretString@ or @SecretBinary@ values are the same as those in the
    --     request then the request is ignored. The operation is idempotent.
    --
    -- -   If a version with this value already exists and the version of the
    --     @SecretString@ and @SecretBinary@ values are different from those in
    --     the request, then the request fails because you can\'t modify a
    --     secret version. You can only create new versions to store new secret
    --     values.
    --
    -- This value becomes the @VersionId@ of the new version.
    PutSecretValue -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The binary data to encrypt and store in the new version of the secret.
    -- To use this parameter in the command-line tools, we recommend that you
    -- store your binary data in a file and then pass the contents of the file
    -- as a parameter.
    --
    -- You must include @SecretBinary@ or @SecretString@, but not both.
    --
    -- You can\'t access this value from the Secrets Manager console.
    PutSecretValue -> Maybe (Sensitive Base64)
secretBinary :: Prelude.Maybe (Data.Sensitive Data.Base64),
    -- | The text to encrypt and store in the new version of the secret.
    --
    -- You must include @SecretBinary@ or @SecretString@, but not both.
    --
    -- We recommend you create the secret string as JSON key\/value pairs, as
    -- shown in the example.
    PutSecretValue -> Maybe (Sensitive Text)
secretString :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A list of staging labels to attach to this version of the secret.
    -- Secrets Manager uses staging labels to track versions of a secret
    -- through the rotation process.
    --
    -- If you specify a staging label that\'s already associated with a
    -- different version of the same secret, then Secrets Manager removes the
    -- label from the other version and attaches it to this version. If you
    -- specify @AWSCURRENT@, and it is already attached to another version,
    -- then Secrets Manager also moves the staging label @AWSPREVIOUS@ to the
    -- version that @AWSCURRENT@ was removed from.
    --
    -- If you don\'t include @VersionStages@, then Secrets Manager
    -- automatically moves the staging label @AWSCURRENT@ to this version.
    PutSecretValue -> Maybe (NonEmpty Text)
versionStages :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The ARN or name of the secret to add a new version to.
    --
    -- 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>.
    --
    -- If the secret doesn\'t already exist, use @CreateSecret@ instead.
    PutSecretValue -> Text
secretId :: Prelude.Text
  }
  deriving (PutSecretValue -> PutSecretValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutSecretValue -> PutSecretValue -> Bool
$c/= :: PutSecretValue -> PutSecretValue -> Bool
== :: PutSecretValue -> PutSecretValue -> Bool
$c== :: PutSecretValue -> PutSecretValue -> Bool
Prelude.Eq, Int -> PutSecretValue -> ShowS
[PutSecretValue] -> ShowS
PutSecretValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSecretValue] -> ShowS
$cshowList :: [PutSecretValue] -> ShowS
show :: PutSecretValue -> String
$cshow :: PutSecretValue -> String
showsPrec :: Int -> PutSecretValue -> ShowS
$cshowsPrec :: Int -> PutSecretValue -> ShowS
Prelude.Show, forall x. Rep PutSecretValue x -> PutSecretValue
forall x. PutSecretValue -> Rep PutSecretValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutSecretValue x -> PutSecretValue
$cfrom :: forall x. PutSecretValue -> Rep PutSecretValue x
Prelude.Generic)

-- |
-- Create a value of 'PutSecretValue' 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:
--
-- 'clientRequestToken', 'putSecretValue_clientRequestToken' - A unique identifier for the new version of the secret.
--
-- If you use the Amazon Web Services CLI or one of the Amazon Web Services
-- SDKs to call this operation, then you can leave this parameter empty
-- because they generate a random UUID for you. If you don\'t use the SDK
-- and instead generate a raw HTTP request to the Secrets Manager service
-- endpoint, then you must generate a @ClientRequestToken@ yourself for new
-- versions and include that value in the request.
--
-- This value helps ensure idempotency. Secrets Manager uses this value to
-- prevent the accidental creation of duplicate versions if there are
-- failures and retries during the Lambda rotation function processing. We
-- recommend that you generate a
-- <https://wikipedia.org/wiki/Universally_unique_identifier UUID-type>
-- value to ensure uniqueness within the specified secret.
--
-- -   If the @ClientRequestToken@ value isn\'t already associated with a
--     version of the secret then a new version of the secret is created.
--
-- -   If a version with this value already exists and that version\'s
--     @SecretString@ or @SecretBinary@ values are the same as those in the
--     request then the request is ignored. The operation is idempotent.
--
-- -   If a version with this value already exists and the version of the
--     @SecretString@ and @SecretBinary@ values are different from those in
--     the request, then the request fails because you can\'t modify a
--     secret version. You can only create new versions to store new secret
--     values.
--
-- This value becomes the @VersionId@ of the new version.
--
-- 'secretBinary', 'putSecretValue_secretBinary' - The binary data to encrypt and store in the new version of the secret.
-- To use this parameter in the command-line tools, we recommend that you
-- store your binary data in a file and then pass the contents of the file
-- as a parameter.
--
-- You must include @SecretBinary@ or @SecretString@, but not both.
--
-- You can\'t access this value from the Secrets Manager console.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'secretString', 'putSecretValue_secretString' - The text to encrypt and store in the new version of the secret.
--
-- You must include @SecretBinary@ or @SecretString@, but not both.
--
-- We recommend you create the secret string as JSON key\/value pairs, as
-- shown in the example.
--
-- 'versionStages', 'putSecretValue_versionStages' - A list of staging labels to attach to this version of the secret.
-- Secrets Manager uses staging labels to track versions of a secret
-- through the rotation process.
--
-- If you specify a staging label that\'s already associated with a
-- different version of the same secret, then Secrets Manager removes the
-- label from the other version and attaches it to this version. If you
-- specify @AWSCURRENT@, and it is already attached to another version,
-- then Secrets Manager also moves the staging label @AWSPREVIOUS@ to the
-- version that @AWSCURRENT@ was removed from.
--
-- If you don\'t include @VersionStages@, then Secrets Manager
-- automatically moves the staging label @AWSCURRENT@ to this version.
--
-- 'secretId', 'putSecretValue_secretId' - The ARN or name of the secret to add a new version to.
--
-- 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>.
--
-- If the secret doesn\'t already exist, use @CreateSecret@ instead.
newPutSecretValue ::
  -- | 'secretId'
  Prelude.Text ->
  PutSecretValue
newPutSecretValue :: Text -> PutSecretValue
newPutSecretValue Text
pSecretId_ =
  PutSecretValue'
    { $sel:clientRequestToken:PutSecretValue' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:secretBinary:PutSecretValue' :: Maybe (Sensitive Base64)
secretBinary = forall a. Maybe a
Prelude.Nothing,
      $sel:secretString:PutSecretValue' :: Maybe (Sensitive Text)
secretString = forall a. Maybe a
Prelude.Nothing,
      $sel:versionStages:PutSecretValue' :: Maybe (NonEmpty Text)
versionStages = forall a. Maybe a
Prelude.Nothing,
      $sel:secretId:PutSecretValue' :: Text
secretId = Text
pSecretId_
    }

-- | A unique identifier for the new version of the secret.
--
-- If you use the Amazon Web Services CLI or one of the Amazon Web Services
-- SDKs to call this operation, then you can leave this parameter empty
-- because they generate a random UUID for you. If you don\'t use the SDK
-- and instead generate a raw HTTP request to the Secrets Manager service
-- endpoint, then you must generate a @ClientRequestToken@ yourself for new
-- versions and include that value in the request.
--
-- This value helps ensure idempotency. Secrets Manager uses this value to
-- prevent the accidental creation of duplicate versions if there are
-- failures and retries during the Lambda rotation function processing. We
-- recommend that you generate a
-- <https://wikipedia.org/wiki/Universally_unique_identifier UUID-type>
-- value to ensure uniqueness within the specified secret.
--
-- -   If the @ClientRequestToken@ value isn\'t already associated with a
--     version of the secret then a new version of the secret is created.
--
-- -   If a version with this value already exists and that version\'s
--     @SecretString@ or @SecretBinary@ values are the same as those in the
--     request then the request is ignored. The operation is idempotent.
--
-- -   If a version with this value already exists and the version of the
--     @SecretString@ and @SecretBinary@ values are different from those in
--     the request, then the request fails because you can\'t modify a
--     secret version. You can only create new versions to store new secret
--     values.
--
-- This value becomes the @VersionId@ of the new version.
putSecretValue_clientRequestToken :: Lens.Lens' PutSecretValue (Prelude.Maybe Prelude.Text)
putSecretValue_clientRequestToken :: Lens' PutSecretValue (Maybe Text)
putSecretValue_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValue' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:PutSecretValue' :: PutSecretValue -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: PutSecretValue
s@PutSecretValue' {} Maybe Text
a -> PutSecretValue
s {$sel:clientRequestToken:PutSecretValue' :: Maybe Text
clientRequestToken = Maybe Text
a} :: PutSecretValue)

-- | The binary data to encrypt and store in the new version of the secret.
-- To use this parameter in the command-line tools, we recommend that you
-- store your binary data in a file and then pass the contents of the file
-- as a parameter.
--
-- You must include @SecretBinary@ or @SecretString@, but not both.
--
-- You can\'t access this value from the Secrets Manager console.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
putSecretValue_secretBinary :: Lens.Lens' PutSecretValue (Prelude.Maybe Prelude.ByteString)
putSecretValue_secretBinary :: Lens' PutSecretValue (Maybe ByteString)
putSecretValue_secretBinary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValue' {Maybe (Sensitive Base64)
secretBinary :: Maybe (Sensitive Base64)
$sel:secretBinary:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Base64)
secretBinary} -> Maybe (Sensitive Base64)
secretBinary) (\s :: PutSecretValue
s@PutSecretValue' {} Maybe (Sensitive Base64)
a -> PutSecretValue
s {$sel:secretBinary:PutSecretValue' :: Maybe (Sensitive Base64)
secretBinary = Maybe (Sensitive Base64)
a} :: PutSecretValue) 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. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64)

-- | The text to encrypt and store in the new version of the secret.
--
-- You must include @SecretBinary@ or @SecretString@, but not both.
--
-- We recommend you create the secret string as JSON key\/value pairs, as
-- shown in the example.
putSecretValue_secretString :: Lens.Lens' PutSecretValue (Prelude.Maybe Prelude.Text)
putSecretValue_secretString :: Lens' PutSecretValue (Maybe Text)
putSecretValue_secretString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValue' {Maybe (Sensitive Text)
secretString :: Maybe (Sensitive Text)
$sel:secretString:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Text)
secretString} -> Maybe (Sensitive Text)
secretString) (\s :: PutSecretValue
s@PutSecretValue' {} Maybe (Sensitive Text)
a -> PutSecretValue
s {$sel:secretString:PutSecretValue' :: Maybe (Sensitive Text)
secretString = Maybe (Sensitive Text)
a} :: PutSecretValue) 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. Iso' (Sensitive a) a
Data._Sensitive

-- | A list of staging labels to attach to this version of the secret.
-- Secrets Manager uses staging labels to track versions of a secret
-- through the rotation process.
--
-- If you specify a staging label that\'s already associated with a
-- different version of the same secret, then Secrets Manager removes the
-- label from the other version and attaches it to this version. If you
-- specify @AWSCURRENT@, and it is already attached to another version,
-- then Secrets Manager also moves the staging label @AWSPREVIOUS@ to the
-- version that @AWSCURRENT@ was removed from.
--
-- If you don\'t include @VersionStages@, then Secrets Manager
-- automatically moves the staging label @AWSCURRENT@ to this version.
putSecretValue_versionStages :: Lens.Lens' PutSecretValue (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
putSecretValue_versionStages :: Lens' PutSecretValue (Maybe (NonEmpty Text))
putSecretValue_versionStages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValue' {Maybe (NonEmpty Text)
versionStages :: Maybe (NonEmpty Text)
$sel:versionStages:PutSecretValue' :: PutSecretValue -> Maybe (NonEmpty Text)
versionStages} -> Maybe (NonEmpty Text)
versionStages) (\s :: PutSecretValue
s@PutSecretValue' {} Maybe (NonEmpty Text)
a -> PutSecretValue
s {$sel:versionStages:PutSecretValue' :: Maybe (NonEmpty Text)
versionStages = Maybe (NonEmpty Text)
a} :: PutSecretValue) 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 ARN or name of the secret to add a new version to.
--
-- 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>.
--
-- If the secret doesn\'t already exist, use @CreateSecret@ instead.
putSecretValue_secretId :: Lens.Lens' PutSecretValue Prelude.Text
putSecretValue_secretId :: Lens' PutSecretValue Text
putSecretValue_secretId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValue' {Text
secretId :: Text
$sel:secretId:PutSecretValue' :: PutSecretValue -> Text
secretId} -> Text
secretId) (\s :: PutSecretValue
s@PutSecretValue' {} Text
a -> PutSecretValue
s {$sel:secretId:PutSecretValue' :: Text
secretId = Text
a} :: PutSecretValue)

instance Core.AWSRequest PutSecretValue where
  type
    AWSResponse PutSecretValue =
      PutSecretValueResponse
  request :: (Service -> Service) -> PutSecretValue -> Request PutSecretValue
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 PutSecretValue
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutSecretValue)))
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 Text
-> Maybe (NonEmpty Text)
-> Int
-> PutSecretValueResponse
PutSecretValueResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VersionId")
            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
"VersionStages")
            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 PutSecretValue where
  hashWithSalt :: Int -> PutSecretValue -> Int
hashWithSalt Int
_salt PutSecretValue' {Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe (Sensitive Base64)
Text
secretId :: Text
versionStages :: Maybe (NonEmpty Text)
secretString :: Maybe (Sensitive Text)
secretBinary :: Maybe (Sensitive Base64)
clientRequestToken :: Maybe Text
$sel:secretId:PutSecretValue' :: PutSecretValue -> Text
$sel:versionStages:PutSecretValue' :: PutSecretValue -> Maybe (NonEmpty Text)
$sel:secretString:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Text)
$sel:secretBinary:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Base64)
$sel:clientRequestToken:PutSecretValue' :: PutSecretValue -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Base64)
secretBinary
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
secretString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
versionStages
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
secretId

instance Prelude.NFData PutSecretValue where
  rnf :: PutSecretValue -> ()
rnf PutSecretValue' {Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe (Sensitive Base64)
Text
secretId :: Text
versionStages :: Maybe (NonEmpty Text)
secretString :: Maybe (Sensitive Text)
secretBinary :: Maybe (Sensitive Base64)
clientRequestToken :: Maybe Text
$sel:secretId:PutSecretValue' :: PutSecretValue -> Text
$sel:versionStages:PutSecretValue' :: PutSecretValue -> Maybe (NonEmpty Text)
$sel:secretString:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Text)
$sel:secretBinary:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Base64)
$sel:clientRequestToken:PutSecretValue' :: PutSecretValue -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Base64)
secretBinary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
secretString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
versionStages
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
secretId

instance Data.ToHeaders PutSecretValue where
  toHeaders :: PutSecretValue -> 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.PutSecretValue" ::
                          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 PutSecretValue where
  toJSON :: PutSecretValue -> Value
toJSON PutSecretValue' {Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe (Sensitive Base64)
Text
secretId :: Text
versionStages :: Maybe (NonEmpty Text)
secretString :: Maybe (Sensitive Text)
secretBinary :: Maybe (Sensitive Base64)
clientRequestToken :: Maybe Text
$sel:secretId:PutSecretValue' :: PutSecretValue -> Text
$sel:versionStages:PutSecretValue' :: PutSecretValue -> Maybe (NonEmpty Text)
$sel:secretString:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Text)
$sel:secretBinary:PutSecretValue' :: PutSecretValue -> Maybe (Sensitive Base64)
$sel:clientRequestToken:PutSecretValue' :: PutSecretValue -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"SecretBinary" 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 (Sensitive Base64)
secretBinary,
            (Key
"SecretString" 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 (Sensitive Text)
secretString,
            (Key
"VersionStages" 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 (NonEmpty Text)
versionStages,
            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 PutSecretValue where
  toPath :: PutSecretValue -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newPutSecretValueResponse' smart constructor.
data PutSecretValueResponse = PutSecretValueResponse'
  { -- | The ARN of the secret.
    PutSecretValueResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The name of the secret.
    PutSecretValueResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the version of the secret.
    PutSecretValueResponse -> Maybe Text
versionId :: Prelude.Maybe Prelude.Text,
    -- | The list of staging labels that are currently attached to this version
    -- of the secret. Secrets Manager uses staging labels to track a version as
    -- it progresses through the secret rotation process.
    PutSecretValueResponse -> Maybe (NonEmpty Text)
versionStages :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    PutSecretValueResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutSecretValueResponse -> PutSecretValueResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutSecretValueResponse -> PutSecretValueResponse -> Bool
$c/= :: PutSecretValueResponse -> PutSecretValueResponse -> Bool
== :: PutSecretValueResponse -> PutSecretValueResponse -> Bool
$c== :: PutSecretValueResponse -> PutSecretValueResponse -> Bool
Prelude.Eq, ReadPrec [PutSecretValueResponse]
ReadPrec PutSecretValueResponse
Int -> ReadS PutSecretValueResponse
ReadS [PutSecretValueResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutSecretValueResponse]
$creadListPrec :: ReadPrec [PutSecretValueResponse]
readPrec :: ReadPrec PutSecretValueResponse
$creadPrec :: ReadPrec PutSecretValueResponse
readList :: ReadS [PutSecretValueResponse]
$creadList :: ReadS [PutSecretValueResponse]
readsPrec :: Int -> ReadS PutSecretValueResponse
$creadsPrec :: Int -> ReadS PutSecretValueResponse
Prelude.Read, Int -> PutSecretValueResponse -> ShowS
[PutSecretValueResponse] -> ShowS
PutSecretValueResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutSecretValueResponse] -> ShowS
$cshowList :: [PutSecretValueResponse] -> ShowS
show :: PutSecretValueResponse -> String
$cshow :: PutSecretValueResponse -> String
showsPrec :: Int -> PutSecretValueResponse -> ShowS
$cshowsPrec :: Int -> PutSecretValueResponse -> ShowS
Prelude.Show, forall x. Rep PutSecretValueResponse x -> PutSecretValueResponse
forall x. PutSecretValueResponse -> Rep PutSecretValueResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutSecretValueResponse x -> PutSecretValueResponse
$cfrom :: forall x. PutSecretValueResponse -> Rep PutSecretValueResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutSecretValueResponse' 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', 'putSecretValueResponse_arn' - The ARN of the secret.
--
-- 'name', 'putSecretValueResponse_name' - The name of the secret.
--
-- 'versionId', 'putSecretValueResponse_versionId' - The unique identifier of the version of the secret.
--
-- 'versionStages', 'putSecretValueResponse_versionStages' - The list of staging labels that are currently attached to this version
-- of the secret. Secrets Manager uses staging labels to track a version as
-- it progresses through the secret rotation process.
--
-- 'httpStatus', 'putSecretValueResponse_httpStatus' - The response's http status code.
newPutSecretValueResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutSecretValueResponse
newPutSecretValueResponse :: Int -> PutSecretValueResponse
newPutSecretValueResponse Int
pHttpStatus_ =
  PutSecretValueResponse'
    { $sel:arn:PutSecretValueResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:name:PutSecretValueResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:PutSecretValueResponse' :: Maybe Text
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:versionStages:PutSecretValueResponse' :: Maybe (NonEmpty Text)
versionStages = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutSecretValueResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

-- | The unique identifier of the version of the secret.
putSecretValueResponse_versionId :: Lens.Lens' PutSecretValueResponse (Prelude.Maybe Prelude.Text)
putSecretValueResponse_versionId :: Lens' PutSecretValueResponse (Maybe Text)
putSecretValueResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValueResponse' {Maybe Text
versionId :: Maybe Text
$sel:versionId:PutSecretValueResponse' :: PutSecretValueResponse -> Maybe Text
versionId} -> Maybe Text
versionId) (\s :: PutSecretValueResponse
s@PutSecretValueResponse' {} Maybe Text
a -> PutSecretValueResponse
s {$sel:versionId:PutSecretValueResponse' :: Maybe Text
versionId = Maybe Text
a} :: PutSecretValueResponse)

-- | The list of staging labels that are currently attached to this version
-- of the secret. Secrets Manager uses staging labels to track a version as
-- it progresses through the secret rotation process.
putSecretValueResponse_versionStages :: Lens.Lens' PutSecretValueResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
putSecretValueResponse_versionStages :: Lens' PutSecretValueResponse (Maybe (NonEmpty Text))
putSecretValueResponse_versionStages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValueResponse' {Maybe (NonEmpty Text)
versionStages :: Maybe (NonEmpty Text)
$sel:versionStages:PutSecretValueResponse' :: PutSecretValueResponse -> Maybe (NonEmpty Text)
versionStages} -> Maybe (NonEmpty Text)
versionStages) (\s :: PutSecretValueResponse
s@PutSecretValueResponse' {} Maybe (NonEmpty Text)
a -> PutSecretValueResponse
s {$sel:versionStages:PutSecretValueResponse' :: Maybe (NonEmpty Text)
versionStages = Maybe (NonEmpty Text)
a} :: PutSecretValueResponse) 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.
putSecretValueResponse_httpStatus :: Lens.Lens' PutSecretValueResponse Prelude.Int
putSecretValueResponse_httpStatus :: Lens' PutSecretValueResponse Int
putSecretValueResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutSecretValueResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutSecretValueResponse' :: PutSecretValueResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutSecretValueResponse
s@PutSecretValueResponse' {} Int
a -> PutSecretValueResponse
s {$sel:httpStatus:PutSecretValueResponse' :: Int
httpStatus = Int
a} :: PutSecretValueResponse)

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