{-# 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.Redshift.BatchModifyClusterSnapshots
-- 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 settings for a set of cluster snapshots.
module Amazonka.Redshift.BatchModifyClusterSnapshots
  ( -- * Creating a Request
    BatchModifyClusterSnapshots (..),
    newBatchModifyClusterSnapshots,

    -- * Request Lenses
    batchModifyClusterSnapshots_force,
    batchModifyClusterSnapshots_manualSnapshotRetentionPeriod,
    batchModifyClusterSnapshots_snapshotIdentifierList,

    -- * Destructuring the Response
    BatchModifyClusterSnapshotsResponse (..),
    newBatchModifyClusterSnapshotsResponse,

    -- * Response Lenses
    batchModifyClusterSnapshotsResponse_errors,
    batchModifyClusterSnapshotsResponse_resources,
    batchModifyClusterSnapshotsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newBatchModifyClusterSnapshots' smart constructor.
data BatchModifyClusterSnapshots = BatchModifyClusterSnapshots'
  { -- | A boolean value indicating whether to override an exception if the
    -- retention period has passed.
    BatchModifyClusterSnapshots -> Maybe Bool
force :: Prelude.Maybe Prelude.Bool,
    -- | The number of days that a manual snapshot is retained. If you specify
    -- the value -1, the manual snapshot is retained indefinitely.
    --
    -- The number must be either -1 or an integer between 1 and 3,653.
    --
    -- If you decrease the manual snapshot retention period from its current
    -- value, existing manual snapshots that fall outside of the new retention
    -- period will return an error. If you want to suppress the errors and
    -- delete the snapshots, use the force option.
    BatchModifyClusterSnapshots -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | A list of snapshot identifiers you want to modify.
    BatchModifyClusterSnapshots -> [Text]
snapshotIdentifierList :: [Prelude.Text]
  }
  deriving (BatchModifyClusterSnapshots -> BatchModifyClusterSnapshots -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchModifyClusterSnapshots -> BatchModifyClusterSnapshots -> Bool
$c/= :: BatchModifyClusterSnapshots -> BatchModifyClusterSnapshots -> Bool
== :: BatchModifyClusterSnapshots -> BatchModifyClusterSnapshots -> Bool
$c== :: BatchModifyClusterSnapshots -> BatchModifyClusterSnapshots -> Bool
Prelude.Eq, ReadPrec [BatchModifyClusterSnapshots]
ReadPrec BatchModifyClusterSnapshots
Int -> ReadS BatchModifyClusterSnapshots
ReadS [BatchModifyClusterSnapshots]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchModifyClusterSnapshots]
$creadListPrec :: ReadPrec [BatchModifyClusterSnapshots]
readPrec :: ReadPrec BatchModifyClusterSnapshots
$creadPrec :: ReadPrec BatchModifyClusterSnapshots
readList :: ReadS [BatchModifyClusterSnapshots]
$creadList :: ReadS [BatchModifyClusterSnapshots]
readsPrec :: Int -> ReadS BatchModifyClusterSnapshots
$creadsPrec :: Int -> ReadS BatchModifyClusterSnapshots
Prelude.Read, Int -> BatchModifyClusterSnapshots -> ShowS
[BatchModifyClusterSnapshots] -> ShowS
BatchModifyClusterSnapshots -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchModifyClusterSnapshots] -> ShowS
$cshowList :: [BatchModifyClusterSnapshots] -> ShowS
show :: BatchModifyClusterSnapshots -> String
$cshow :: BatchModifyClusterSnapshots -> String
showsPrec :: Int -> BatchModifyClusterSnapshots -> ShowS
$cshowsPrec :: Int -> BatchModifyClusterSnapshots -> ShowS
Prelude.Show, forall x.
Rep BatchModifyClusterSnapshots x -> BatchModifyClusterSnapshots
forall x.
BatchModifyClusterSnapshots -> Rep BatchModifyClusterSnapshots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchModifyClusterSnapshots x -> BatchModifyClusterSnapshots
$cfrom :: forall x.
BatchModifyClusterSnapshots -> Rep BatchModifyClusterSnapshots x
Prelude.Generic)

-- |
-- Create a value of 'BatchModifyClusterSnapshots' 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:
--
-- 'force', 'batchModifyClusterSnapshots_force' - A boolean value indicating whether to override an exception if the
-- retention period has passed.
--
-- 'manualSnapshotRetentionPeriod', 'batchModifyClusterSnapshots_manualSnapshotRetentionPeriod' - The number of days that a manual snapshot is retained. If you specify
-- the value -1, the manual snapshot is retained indefinitely.
--
-- The number must be either -1 or an integer between 1 and 3,653.
--
-- If you decrease the manual snapshot retention period from its current
-- value, existing manual snapshots that fall outside of the new retention
-- period will return an error. If you want to suppress the errors and
-- delete the snapshots, use the force option.
--
-- 'snapshotIdentifierList', 'batchModifyClusterSnapshots_snapshotIdentifierList' - A list of snapshot identifiers you want to modify.
newBatchModifyClusterSnapshots ::
  BatchModifyClusterSnapshots
newBatchModifyClusterSnapshots :: BatchModifyClusterSnapshots
newBatchModifyClusterSnapshots =
  BatchModifyClusterSnapshots'
    { $sel:force:BatchModifyClusterSnapshots' :: Maybe Bool
force =
        forall a. Maybe a
Prelude.Nothing,
      $sel:manualSnapshotRetentionPeriod:BatchModifyClusterSnapshots' :: Maybe Int
manualSnapshotRetentionPeriod =
        forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotIdentifierList:BatchModifyClusterSnapshots' :: [Text]
snapshotIdentifierList = forall a. Monoid a => a
Prelude.mempty
    }

-- | A boolean value indicating whether to override an exception if the
-- retention period has passed.
batchModifyClusterSnapshots_force :: Lens.Lens' BatchModifyClusterSnapshots (Prelude.Maybe Prelude.Bool)
batchModifyClusterSnapshots_force :: Lens' BatchModifyClusterSnapshots (Maybe Bool)
batchModifyClusterSnapshots_force = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchModifyClusterSnapshots' {Maybe Bool
force :: Maybe Bool
$sel:force:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Bool
force} -> Maybe Bool
force) (\s :: BatchModifyClusterSnapshots
s@BatchModifyClusterSnapshots' {} Maybe Bool
a -> BatchModifyClusterSnapshots
s {$sel:force:BatchModifyClusterSnapshots' :: Maybe Bool
force = Maybe Bool
a} :: BatchModifyClusterSnapshots)

-- | The number of days that a manual snapshot is retained. If you specify
-- the value -1, the manual snapshot is retained indefinitely.
--
-- The number must be either -1 or an integer between 1 and 3,653.
--
-- If you decrease the manual snapshot retention period from its current
-- value, existing manual snapshots that fall outside of the new retention
-- period will return an error. If you want to suppress the errors and
-- delete the snapshots, use the force option.
batchModifyClusterSnapshots_manualSnapshotRetentionPeriod :: Lens.Lens' BatchModifyClusterSnapshots (Prelude.Maybe Prelude.Int)
batchModifyClusterSnapshots_manualSnapshotRetentionPeriod :: Lens' BatchModifyClusterSnapshots (Maybe Int)
batchModifyClusterSnapshots_manualSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchModifyClusterSnapshots' {Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:manualSnapshotRetentionPeriod:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Int
manualSnapshotRetentionPeriod} -> Maybe Int
manualSnapshotRetentionPeriod) (\s :: BatchModifyClusterSnapshots
s@BatchModifyClusterSnapshots' {} Maybe Int
a -> BatchModifyClusterSnapshots
s {$sel:manualSnapshotRetentionPeriod:BatchModifyClusterSnapshots' :: Maybe Int
manualSnapshotRetentionPeriod = Maybe Int
a} :: BatchModifyClusterSnapshots)

-- | A list of snapshot identifiers you want to modify.
batchModifyClusterSnapshots_snapshotIdentifierList :: Lens.Lens' BatchModifyClusterSnapshots [Prelude.Text]
batchModifyClusterSnapshots_snapshotIdentifierList :: Lens' BatchModifyClusterSnapshots [Text]
batchModifyClusterSnapshots_snapshotIdentifierList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchModifyClusterSnapshots' {[Text]
snapshotIdentifierList :: [Text]
$sel:snapshotIdentifierList:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> [Text]
snapshotIdentifierList} -> [Text]
snapshotIdentifierList) (\s :: BatchModifyClusterSnapshots
s@BatchModifyClusterSnapshots' {} [Text]
a -> BatchModifyClusterSnapshots
s {$sel:snapshotIdentifierList:BatchModifyClusterSnapshots' :: [Text]
snapshotIdentifierList = [Text]
a} :: BatchModifyClusterSnapshots) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchModifyClusterSnapshots where
  type
    AWSResponse BatchModifyClusterSnapshots =
      BatchModifyClusterSnapshotsResponse
  request :: (Service -> Service)
-> BatchModifyClusterSnapshots
-> Request BatchModifyClusterSnapshots
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy BatchModifyClusterSnapshots
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchModifyClusterSnapshots)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"BatchModifyClusterSnapshotsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [SnapshotErrorMessage]
-> Maybe [Text] -> Int -> BatchModifyClusterSnapshotsResponse
BatchModifyClusterSnapshotsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Errors"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"SnapshotErrorMessage")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Resources"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"String")
                        )
            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 BatchModifyClusterSnapshots where
  hashWithSalt :: Int -> BatchModifyClusterSnapshots -> Int
hashWithSalt Int
_salt BatchModifyClusterSnapshots' {[Text]
Maybe Bool
Maybe Int
snapshotIdentifierList :: [Text]
manualSnapshotRetentionPeriod :: Maybe Int
force :: Maybe Bool
$sel:snapshotIdentifierList:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> [Text]
$sel:manualSnapshotRetentionPeriod:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Int
$sel:force:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
force
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
manualSnapshotRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
snapshotIdentifierList

instance Prelude.NFData BatchModifyClusterSnapshots where
  rnf :: BatchModifyClusterSnapshots -> ()
rnf BatchModifyClusterSnapshots' {[Text]
Maybe Bool
Maybe Int
snapshotIdentifierList :: [Text]
manualSnapshotRetentionPeriod :: Maybe Int
force :: Maybe Bool
$sel:snapshotIdentifierList:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> [Text]
$sel:manualSnapshotRetentionPeriod:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Int
$sel:force:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
force
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
manualSnapshotRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
snapshotIdentifierList

instance Data.ToHeaders BatchModifyClusterSnapshots where
  toHeaders :: BatchModifyClusterSnapshots -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery BatchModifyClusterSnapshots where
  toQuery :: BatchModifyClusterSnapshots -> QueryString
toQuery BatchModifyClusterSnapshots' {[Text]
Maybe Bool
Maybe Int
snapshotIdentifierList :: [Text]
manualSnapshotRetentionPeriod :: Maybe Int
force :: Maybe Bool
$sel:snapshotIdentifierList:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> [Text]
$sel:manualSnapshotRetentionPeriod:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Int
$sel:force:BatchModifyClusterSnapshots' :: BatchModifyClusterSnapshots -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"BatchModifyClusterSnapshots" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"Force" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
force,
        ByteString
"ManualSnapshotRetentionPeriod"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
manualSnapshotRetentionPeriod,
        ByteString
"SnapshotIdentifierList"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"String" [Text]
snapshotIdentifierList
      ]

-- | /See:/ 'newBatchModifyClusterSnapshotsResponse' smart constructor.
data BatchModifyClusterSnapshotsResponse = BatchModifyClusterSnapshotsResponse'
  { -- | A list of any errors returned.
    BatchModifyClusterSnapshotsResponse -> Maybe [SnapshotErrorMessage]
errors :: Prelude.Maybe [SnapshotErrorMessage],
    -- | A list of the snapshots that were modified.
    BatchModifyClusterSnapshotsResponse -> Maybe [Text]
resources :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    BatchModifyClusterSnapshotsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchModifyClusterSnapshotsResponse
-> BatchModifyClusterSnapshotsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchModifyClusterSnapshotsResponse
-> BatchModifyClusterSnapshotsResponse -> Bool
$c/= :: BatchModifyClusterSnapshotsResponse
-> BatchModifyClusterSnapshotsResponse -> Bool
== :: BatchModifyClusterSnapshotsResponse
-> BatchModifyClusterSnapshotsResponse -> Bool
$c== :: BatchModifyClusterSnapshotsResponse
-> BatchModifyClusterSnapshotsResponse -> Bool
Prelude.Eq, ReadPrec [BatchModifyClusterSnapshotsResponse]
ReadPrec BatchModifyClusterSnapshotsResponse
Int -> ReadS BatchModifyClusterSnapshotsResponse
ReadS [BatchModifyClusterSnapshotsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchModifyClusterSnapshotsResponse]
$creadListPrec :: ReadPrec [BatchModifyClusterSnapshotsResponse]
readPrec :: ReadPrec BatchModifyClusterSnapshotsResponse
$creadPrec :: ReadPrec BatchModifyClusterSnapshotsResponse
readList :: ReadS [BatchModifyClusterSnapshotsResponse]
$creadList :: ReadS [BatchModifyClusterSnapshotsResponse]
readsPrec :: Int -> ReadS BatchModifyClusterSnapshotsResponse
$creadsPrec :: Int -> ReadS BatchModifyClusterSnapshotsResponse
Prelude.Read, Int -> BatchModifyClusterSnapshotsResponse -> ShowS
[BatchModifyClusterSnapshotsResponse] -> ShowS
BatchModifyClusterSnapshotsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchModifyClusterSnapshotsResponse] -> ShowS
$cshowList :: [BatchModifyClusterSnapshotsResponse] -> ShowS
show :: BatchModifyClusterSnapshotsResponse -> String
$cshow :: BatchModifyClusterSnapshotsResponse -> String
showsPrec :: Int -> BatchModifyClusterSnapshotsResponse -> ShowS
$cshowsPrec :: Int -> BatchModifyClusterSnapshotsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchModifyClusterSnapshotsResponse x
-> BatchModifyClusterSnapshotsResponse
forall x.
BatchModifyClusterSnapshotsResponse
-> Rep BatchModifyClusterSnapshotsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchModifyClusterSnapshotsResponse x
-> BatchModifyClusterSnapshotsResponse
$cfrom :: forall x.
BatchModifyClusterSnapshotsResponse
-> Rep BatchModifyClusterSnapshotsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchModifyClusterSnapshotsResponse' 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:
--
-- 'errors', 'batchModifyClusterSnapshotsResponse_errors' - A list of any errors returned.
--
-- 'resources', 'batchModifyClusterSnapshotsResponse_resources' - A list of the snapshots that were modified.
--
-- 'httpStatus', 'batchModifyClusterSnapshotsResponse_httpStatus' - The response's http status code.
newBatchModifyClusterSnapshotsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchModifyClusterSnapshotsResponse
newBatchModifyClusterSnapshotsResponse :: Int -> BatchModifyClusterSnapshotsResponse
newBatchModifyClusterSnapshotsResponse Int
pHttpStatus_ =
  BatchModifyClusterSnapshotsResponse'
    { $sel:errors:BatchModifyClusterSnapshotsResponse' :: Maybe [SnapshotErrorMessage]
errors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resources:BatchModifyClusterSnapshotsResponse' :: Maybe [Text]
resources = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchModifyClusterSnapshotsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of any errors returned.
batchModifyClusterSnapshotsResponse_errors :: Lens.Lens' BatchModifyClusterSnapshotsResponse (Prelude.Maybe [SnapshotErrorMessage])
batchModifyClusterSnapshotsResponse_errors :: Lens'
  BatchModifyClusterSnapshotsResponse (Maybe [SnapshotErrorMessage])
batchModifyClusterSnapshotsResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchModifyClusterSnapshotsResponse' {Maybe [SnapshotErrorMessage]
errors :: Maybe [SnapshotErrorMessage]
$sel:errors:BatchModifyClusterSnapshotsResponse' :: BatchModifyClusterSnapshotsResponse -> Maybe [SnapshotErrorMessage]
errors} -> Maybe [SnapshotErrorMessage]
errors) (\s :: BatchModifyClusterSnapshotsResponse
s@BatchModifyClusterSnapshotsResponse' {} Maybe [SnapshotErrorMessage]
a -> BatchModifyClusterSnapshotsResponse
s {$sel:errors:BatchModifyClusterSnapshotsResponse' :: Maybe [SnapshotErrorMessage]
errors = Maybe [SnapshotErrorMessage]
a} :: BatchModifyClusterSnapshotsResponse) 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 snapshots that were modified.
batchModifyClusterSnapshotsResponse_resources :: Lens.Lens' BatchModifyClusterSnapshotsResponse (Prelude.Maybe [Prelude.Text])
batchModifyClusterSnapshotsResponse_resources :: Lens' BatchModifyClusterSnapshotsResponse (Maybe [Text])
batchModifyClusterSnapshotsResponse_resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchModifyClusterSnapshotsResponse' {Maybe [Text]
resources :: Maybe [Text]
$sel:resources:BatchModifyClusterSnapshotsResponse' :: BatchModifyClusterSnapshotsResponse -> Maybe [Text]
resources} -> Maybe [Text]
resources) (\s :: BatchModifyClusterSnapshotsResponse
s@BatchModifyClusterSnapshotsResponse' {} Maybe [Text]
a -> BatchModifyClusterSnapshotsResponse
s {$sel:resources:BatchModifyClusterSnapshotsResponse' :: Maybe [Text]
resources = Maybe [Text]
a} :: BatchModifyClusterSnapshotsResponse) 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.
batchModifyClusterSnapshotsResponse_httpStatus :: Lens.Lens' BatchModifyClusterSnapshotsResponse Prelude.Int
batchModifyClusterSnapshotsResponse_httpStatus :: Lens' BatchModifyClusterSnapshotsResponse Int
batchModifyClusterSnapshotsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchModifyClusterSnapshotsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchModifyClusterSnapshotsResponse' :: BatchModifyClusterSnapshotsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchModifyClusterSnapshotsResponse
s@BatchModifyClusterSnapshotsResponse' {} Int
a -> BatchModifyClusterSnapshotsResponse
s {$sel:httpStatus:BatchModifyClusterSnapshotsResponse' :: Int
httpStatus = Int
a} :: BatchModifyClusterSnapshotsResponse)

instance
  Prelude.NFData
    BatchModifyClusterSnapshotsResponse
  where
  rnf :: BatchModifyClusterSnapshotsResponse -> ()
rnf BatchModifyClusterSnapshotsResponse' {Int
Maybe [Text]
Maybe [SnapshotErrorMessage]
httpStatus :: Int
resources :: Maybe [Text]
errors :: Maybe [SnapshotErrorMessage]
$sel:httpStatus:BatchModifyClusterSnapshotsResponse' :: BatchModifyClusterSnapshotsResponse -> Int
$sel:resources:BatchModifyClusterSnapshotsResponse' :: BatchModifyClusterSnapshotsResponse -> Maybe [Text]
$sel:errors:BatchModifyClusterSnapshotsResponse' :: BatchModifyClusterSnapshotsResponse -> Maybe [SnapshotErrorMessage]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [SnapshotErrorMessage]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
resources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus