{-# 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.ModifyClusterSnapshot
-- 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 snapshot.
--
-- This exanmple modifies the manual retention period setting for a cluster
-- snapshot.
module Amazonka.Redshift.ModifyClusterSnapshot
  ( -- * Creating a Request
    ModifyClusterSnapshot (..),
    newModifyClusterSnapshot,

    -- * Request Lenses
    modifyClusterSnapshot_force,
    modifyClusterSnapshot_manualSnapshotRetentionPeriod,
    modifyClusterSnapshot_snapshotIdentifier,

    -- * Destructuring the Response
    ModifyClusterSnapshotResponse (..),
    newModifyClusterSnapshotResponse,

    -- * Response Lenses
    modifyClusterSnapshotResponse_snapshot,
    modifyClusterSnapshotResponse_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:/ 'newModifyClusterSnapshot' smart constructor.
data ModifyClusterSnapshot = ModifyClusterSnapshot'
  { -- | A Boolean option to override an exception if the retention period has
    -- already passed.
    ModifyClusterSnapshot -> Maybe Bool
force :: Prelude.Maybe Prelude.Bool,
    -- | The number of days that a manual snapshot is retained. If the value is
    -- -1, the manual snapshot is retained indefinitely.
    --
    -- If the manual snapshot falls outside of the new retention period, you
    -- can specify the force option to immediately delete the snapshot.
    --
    -- The value must be either -1 or an integer between 1 and 3,653.
    ModifyClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The identifier of the snapshot whose setting you want to modify.
    ModifyClusterSnapshot -> Text
snapshotIdentifier :: Prelude.Text
  }
  deriving (ModifyClusterSnapshot -> ModifyClusterSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyClusterSnapshot -> ModifyClusterSnapshot -> Bool
$c/= :: ModifyClusterSnapshot -> ModifyClusterSnapshot -> Bool
== :: ModifyClusterSnapshot -> ModifyClusterSnapshot -> Bool
$c== :: ModifyClusterSnapshot -> ModifyClusterSnapshot -> Bool
Prelude.Eq, ReadPrec [ModifyClusterSnapshot]
ReadPrec ModifyClusterSnapshot
Int -> ReadS ModifyClusterSnapshot
ReadS [ModifyClusterSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyClusterSnapshot]
$creadListPrec :: ReadPrec [ModifyClusterSnapshot]
readPrec :: ReadPrec ModifyClusterSnapshot
$creadPrec :: ReadPrec ModifyClusterSnapshot
readList :: ReadS [ModifyClusterSnapshot]
$creadList :: ReadS [ModifyClusterSnapshot]
readsPrec :: Int -> ReadS ModifyClusterSnapshot
$creadsPrec :: Int -> ReadS ModifyClusterSnapshot
Prelude.Read, Int -> ModifyClusterSnapshot -> ShowS
[ModifyClusterSnapshot] -> ShowS
ModifyClusterSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyClusterSnapshot] -> ShowS
$cshowList :: [ModifyClusterSnapshot] -> ShowS
show :: ModifyClusterSnapshot -> String
$cshow :: ModifyClusterSnapshot -> String
showsPrec :: Int -> ModifyClusterSnapshot -> ShowS
$cshowsPrec :: Int -> ModifyClusterSnapshot -> ShowS
Prelude.Show, forall x. Rep ModifyClusterSnapshot x -> ModifyClusterSnapshot
forall x. ModifyClusterSnapshot -> Rep ModifyClusterSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyClusterSnapshot x -> ModifyClusterSnapshot
$cfrom :: forall x. ModifyClusterSnapshot -> Rep ModifyClusterSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'ModifyClusterSnapshot' 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', 'modifyClusterSnapshot_force' - A Boolean option to override an exception if the retention period has
-- already passed.
--
-- 'manualSnapshotRetentionPeriod', 'modifyClusterSnapshot_manualSnapshotRetentionPeriod' - The number of days that a manual snapshot is retained. If the value is
-- -1, the manual snapshot is retained indefinitely.
--
-- If the manual snapshot falls outside of the new retention period, you
-- can specify the force option to immediately delete the snapshot.
--
-- The value must be either -1 or an integer between 1 and 3,653.
--
-- 'snapshotIdentifier', 'modifyClusterSnapshot_snapshotIdentifier' - The identifier of the snapshot whose setting you want to modify.
newModifyClusterSnapshot ::
  -- | 'snapshotIdentifier'
  Prelude.Text ->
  ModifyClusterSnapshot
newModifyClusterSnapshot :: Text -> ModifyClusterSnapshot
newModifyClusterSnapshot Text
pSnapshotIdentifier_ =
  ModifyClusterSnapshot'
    { $sel:force:ModifyClusterSnapshot' :: Maybe Bool
force = forall a. Maybe a
Prelude.Nothing,
      $sel:manualSnapshotRetentionPeriod:ModifyClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotIdentifier:ModifyClusterSnapshot' :: Text
snapshotIdentifier = Text
pSnapshotIdentifier_
    }

-- | A Boolean option to override an exception if the retention period has
-- already passed.
modifyClusterSnapshot_force :: Lens.Lens' ModifyClusterSnapshot (Prelude.Maybe Prelude.Bool)
modifyClusterSnapshot_force :: Lens' ModifyClusterSnapshot (Maybe Bool)
modifyClusterSnapshot_force = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterSnapshot' {Maybe Bool
force :: Maybe Bool
$sel:force:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Maybe Bool
force} -> Maybe Bool
force) (\s :: ModifyClusterSnapshot
s@ModifyClusterSnapshot' {} Maybe Bool
a -> ModifyClusterSnapshot
s {$sel:force:ModifyClusterSnapshot' :: Maybe Bool
force = Maybe Bool
a} :: ModifyClusterSnapshot)

-- | The number of days that a manual snapshot is retained. If the value is
-- -1, the manual snapshot is retained indefinitely.
--
-- If the manual snapshot falls outside of the new retention period, you
-- can specify the force option to immediately delete the snapshot.
--
-- The value must be either -1 or an integer between 1 and 3,653.
modifyClusterSnapshot_manualSnapshotRetentionPeriod :: Lens.Lens' ModifyClusterSnapshot (Prelude.Maybe Prelude.Int)
modifyClusterSnapshot_manualSnapshotRetentionPeriod :: Lens' ModifyClusterSnapshot (Maybe Int)
modifyClusterSnapshot_manualSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterSnapshot' {Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:manualSnapshotRetentionPeriod:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod} -> Maybe Int
manualSnapshotRetentionPeriod) (\s :: ModifyClusterSnapshot
s@ModifyClusterSnapshot' {} Maybe Int
a -> ModifyClusterSnapshot
s {$sel:manualSnapshotRetentionPeriod:ModifyClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod = Maybe Int
a} :: ModifyClusterSnapshot)

-- | The identifier of the snapshot whose setting you want to modify.
modifyClusterSnapshot_snapshotIdentifier :: Lens.Lens' ModifyClusterSnapshot Prelude.Text
modifyClusterSnapshot_snapshotIdentifier :: Lens' ModifyClusterSnapshot Text
modifyClusterSnapshot_snapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterSnapshot' {Text
snapshotIdentifier :: Text
$sel:snapshotIdentifier:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Text
snapshotIdentifier} -> Text
snapshotIdentifier) (\s :: ModifyClusterSnapshot
s@ModifyClusterSnapshot' {} Text
a -> ModifyClusterSnapshot
s {$sel:snapshotIdentifier:ModifyClusterSnapshot' :: Text
snapshotIdentifier = Text
a} :: ModifyClusterSnapshot)

instance Core.AWSRequest ModifyClusterSnapshot where
  type
    AWSResponse ModifyClusterSnapshot =
      ModifyClusterSnapshotResponse
  request :: (Service -> Service)
-> ModifyClusterSnapshot -> Request ModifyClusterSnapshot
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 ModifyClusterSnapshot
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyClusterSnapshot)))
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
"ModifyClusterSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Snapshot -> Int -> ModifyClusterSnapshotResponse
ModifyClusterSnapshotResponse'
            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
"Snapshot")
            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 ModifyClusterSnapshot where
  hashWithSalt :: Int -> ModifyClusterSnapshot -> Int
hashWithSalt Int
_salt ModifyClusterSnapshot' {Maybe Bool
Maybe Int
Text
snapshotIdentifier :: Text
manualSnapshotRetentionPeriod :: Maybe Int
force :: Maybe Bool
$sel:snapshotIdentifier:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Text
$sel:manualSnapshotRetentionPeriod:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Maybe Int
$sel:force:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> 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
snapshotIdentifier

instance Prelude.NFData ModifyClusterSnapshot where
  rnf :: ModifyClusterSnapshot -> ()
rnf ModifyClusterSnapshot' {Maybe Bool
Maybe Int
Text
snapshotIdentifier :: Text
manualSnapshotRetentionPeriod :: Maybe Int
force :: Maybe Bool
$sel:snapshotIdentifier:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Text
$sel:manualSnapshotRetentionPeriod:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Maybe Int
$sel:force:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> 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
snapshotIdentifier

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

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

instance Data.ToQuery ModifyClusterSnapshot where
  toQuery :: ModifyClusterSnapshot -> QueryString
toQuery ModifyClusterSnapshot' {Maybe Bool
Maybe Int
Text
snapshotIdentifier :: Text
manualSnapshotRetentionPeriod :: Maybe Int
force :: Maybe Bool
$sel:snapshotIdentifier:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Text
$sel:manualSnapshotRetentionPeriod:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Maybe Int
$sel:force:ModifyClusterSnapshot' :: ModifyClusterSnapshot -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyClusterSnapshot" :: 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
"SnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
snapshotIdentifier
      ]

-- | /See:/ 'newModifyClusterSnapshotResponse' smart constructor.
data ModifyClusterSnapshotResponse = ModifyClusterSnapshotResponse'
  { ModifyClusterSnapshotResponse -> Maybe Snapshot
snapshot :: Prelude.Maybe Snapshot,
    -- | The response's http status code.
    ModifyClusterSnapshotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyClusterSnapshotResponse
-> ModifyClusterSnapshotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyClusterSnapshotResponse
-> ModifyClusterSnapshotResponse -> Bool
$c/= :: ModifyClusterSnapshotResponse
-> ModifyClusterSnapshotResponse -> Bool
== :: ModifyClusterSnapshotResponse
-> ModifyClusterSnapshotResponse -> Bool
$c== :: ModifyClusterSnapshotResponse
-> ModifyClusterSnapshotResponse -> Bool
Prelude.Eq, ReadPrec [ModifyClusterSnapshotResponse]
ReadPrec ModifyClusterSnapshotResponse
Int -> ReadS ModifyClusterSnapshotResponse
ReadS [ModifyClusterSnapshotResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyClusterSnapshotResponse]
$creadListPrec :: ReadPrec [ModifyClusterSnapshotResponse]
readPrec :: ReadPrec ModifyClusterSnapshotResponse
$creadPrec :: ReadPrec ModifyClusterSnapshotResponse
readList :: ReadS [ModifyClusterSnapshotResponse]
$creadList :: ReadS [ModifyClusterSnapshotResponse]
readsPrec :: Int -> ReadS ModifyClusterSnapshotResponse
$creadsPrec :: Int -> ReadS ModifyClusterSnapshotResponse
Prelude.Read, Int -> ModifyClusterSnapshotResponse -> ShowS
[ModifyClusterSnapshotResponse] -> ShowS
ModifyClusterSnapshotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyClusterSnapshotResponse] -> ShowS
$cshowList :: [ModifyClusterSnapshotResponse] -> ShowS
show :: ModifyClusterSnapshotResponse -> String
$cshow :: ModifyClusterSnapshotResponse -> String
showsPrec :: Int -> ModifyClusterSnapshotResponse -> ShowS
$cshowsPrec :: Int -> ModifyClusterSnapshotResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyClusterSnapshotResponse x
-> ModifyClusterSnapshotResponse
forall x.
ModifyClusterSnapshotResponse
-> Rep ModifyClusterSnapshotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyClusterSnapshotResponse x
-> ModifyClusterSnapshotResponse
$cfrom :: forall x.
ModifyClusterSnapshotResponse
-> Rep ModifyClusterSnapshotResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyClusterSnapshotResponse' 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:
--
-- 'snapshot', 'modifyClusterSnapshotResponse_snapshot' - Undocumented member.
--
-- 'httpStatus', 'modifyClusterSnapshotResponse_httpStatus' - The response's http status code.
newModifyClusterSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyClusterSnapshotResponse
newModifyClusterSnapshotResponse :: Int -> ModifyClusterSnapshotResponse
newModifyClusterSnapshotResponse Int
pHttpStatus_ =
  ModifyClusterSnapshotResponse'
    { $sel:snapshot:ModifyClusterSnapshotResponse' :: Maybe Snapshot
snapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyClusterSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
modifyClusterSnapshotResponse_snapshot :: Lens.Lens' ModifyClusterSnapshotResponse (Prelude.Maybe Snapshot)
modifyClusterSnapshotResponse_snapshot :: Lens' ModifyClusterSnapshotResponse (Maybe Snapshot)
modifyClusterSnapshotResponse_snapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterSnapshotResponse' {Maybe Snapshot
snapshot :: Maybe Snapshot
$sel:snapshot:ModifyClusterSnapshotResponse' :: ModifyClusterSnapshotResponse -> Maybe Snapshot
snapshot} -> Maybe Snapshot
snapshot) (\s :: ModifyClusterSnapshotResponse
s@ModifyClusterSnapshotResponse' {} Maybe Snapshot
a -> ModifyClusterSnapshotResponse
s {$sel:snapshot:ModifyClusterSnapshotResponse' :: Maybe Snapshot
snapshot = Maybe Snapshot
a} :: ModifyClusterSnapshotResponse)

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

instance Prelude.NFData ModifyClusterSnapshotResponse where
  rnf :: ModifyClusterSnapshotResponse -> ()
rnf ModifyClusterSnapshotResponse' {Int
Maybe Snapshot
httpStatus :: Int
snapshot :: Maybe Snapshot
$sel:httpStatus:ModifyClusterSnapshotResponse' :: ModifyClusterSnapshotResponse -> Int
$sel:snapshot:ModifyClusterSnapshotResponse' :: ModifyClusterSnapshotResponse -> Maybe Snapshot
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Snapshot
snapshot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus