{-# 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.CreateSnapshotSchedule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a snapshot schedule that can be associated to a cluster and which
-- overrides the default system backup schedule.
module Amazonka.Redshift.CreateSnapshotSchedule
  ( -- * Creating a Request
    CreateSnapshotSchedule (..),
    newCreateSnapshotSchedule,

    -- * Request Lenses
    createSnapshotSchedule_dryRun,
    createSnapshotSchedule_nextInvocations,
    createSnapshotSchedule_scheduleDefinitions,
    createSnapshotSchedule_scheduleDescription,
    createSnapshotSchedule_scheduleIdentifier,
    createSnapshotSchedule_tags,

    -- * Destructuring the Response
    SnapshotSchedule (..),
    newSnapshotSchedule,

    -- * Response Lenses
    snapshotSchedule_associatedClusterCount,
    snapshotSchedule_associatedClusters,
    snapshotSchedule_nextInvocations,
    snapshotSchedule_scheduleDefinitions,
    snapshotSchedule_scheduleDescription,
    snapshotSchedule_scheduleIdentifier,
    snapshotSchedule_tags,
  )
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:/ 'newCreateSnapshotSchedule' smart constructor.
data CreateSnapshotSchedule = CreateSnapshotSchedule'
  { CreateSnapshotSchedule -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    CreateSnapshotSchedule -> Maybe Int
nextInvocations :: Prelude.Maybe Prelude.Int,
    -- | The definition of the snapshot schedule. The definition is made up of
    -- schedule expressions, for example \"cron(30 12 *)\" or \"rate(12
    -- hours)\".
    CreateSnapshotSchedule -> Maybe [Text]
scheduleDefinitions :: Prelude.Maybe [Prelude.Text],
    -- | The description of the snapshot schedule.
    CreateSnapshotSchedule -> Maybe Text
scheduleDescription :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for a snapshot schedule. Only alphanumeric
    -- characters are allowed for the identifier.
    CreateSnapshotSchedule -> Maybe Text
scheduleIdentifier :: Prelude.Maybe Prelude.Text,
    -- | An optional set of tags you can use to search for the schedule.
    CreateSnapshotSchedule -> Maybe [Tag]
tags :: Prelude.Maybe [Tag]
  }
  deriving (CreateSnapshotSchedule -> CreateSnapshotSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSnapshotSchedule -> CreateSnapshotSchedule -> Bool
$c/= :: CreateSnapshotSchedule -> CreateSnapshotSchedule -> Bool
== :: CreateSnapshotSchedule -> CreateSnapshotSchedule -> Bool
$c== :: CreateSnapshotSchedule -> CreateSnapshotSchedule -> Bool
Prelude.Eq, ReadPrec [CreateSnapshotSchedule]
ReadPrec CreateSnapshotSchedule
Int -> ReadS CreateSnapshotSchedule
ReadS [CreateSnapshotSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSnapshotSchedule]
$creadListPrec :: ReadPrec [CreateSnapshotSchedule]
readPrec :: ReadPrec CreateSnapshotSchedule
$creadPrec :: ReadPrec CreateSnapshotSchedule
readList :: ReadS [CreateSnapshotSchedule]
$creadList :: ReadS [CreateSnapshotSchedule]
readsPrec :: Int -> ReadS CreateSnapshotSchedule
$creadsPrec :: Int -> ReadS CreateSnapshotSchedule
Prelude.Read, Int -> CreateSnapshotSchedule -> ShowS
[CreateSnapshotSchedule] -> ShowS
CreateSnapshotSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSnapshotSchedule] -> ShowS
$cshowList :: [CreateSnapshotSchedule] -> ShowS
show :: CreateSnapshotSchedule -> String
$cshow :: CreateSnapshotSchedule -> String
showsPrec :: Int -> CreateSnapshotSchedule -> ShowS
$cshowsPrec :: Int -> CreateSnapshotSchedule -> ShowS
Prelude.Show, forall x. Rep CreateSnapshotSchedule x -> CreateSnapshotSchedule
forall x. CreateSnapshotSchedule -> Rep CreateSnapshotSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSnapshotSchedule x -> CreateSnapshotSchedule
$cfrom :: forall x. CreateSnapshotSchedule -> Rep CreateSnapshotSchedule x
Prelude.Generic)

-- |
-- Create a value of 'CreateSnapshotSchedule' 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:
--
-- 'dryRun', 'createSnapshotSchedule_dryRun' -
--
-- 'nextInvocations', 'createSnapshotSchedule_nextInvocations' -
--
-- 'scheduleDefinitions', 'createSnapshotSchedule_scheduleDefinitions' - The definition of the snapshot schedule. The definition is made up of
-- schedule expressions, for example \"cron(30 12 *)\" or \"rate(12
-- hours)\".
--
-- 'scheduleDescription', 'createSnapshotSchedule_scheduleDescription' - The description of the snapshot schedule.
--
-- 'scheduleIdentifier', 'createSnapshotSchedule_scheduleIdentifier' - A unique identifier for a snapshot schedule. Only alphanumeric
-- characters are allowed for the identifier.
--
-- 'tags', 'createSnapshotSchedule_tags' - An optional set of tags you can use to search for the schedule.
newCreateSnapshotSchedule ::
  CreateSnapshotSchedule
newCreateSnapshotSchedule :: CreateSnapshotSchedule
newCreateSnapshotSchedule =
  CreateSnapshotSchedule'
    { $sel:dryRun:CreateSnapshotSchedule' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:nextInvocations:CreateSnapshotSchedule' :: Maybe Int
nextInvocations = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleDefinitions:CreateSnapshotSchedule' :: Maybe [Text]
scheduleDefinitions = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleDescription:CreateSnapshotSchedule' :: Maybe Text
scheduleDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleIdentifier:CreateSnapshotSchedule' :: Maybe Text
scheduleIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSnapshotSchedule' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing
    }

createSnapshotSchedule_dryRun :: Lens.Lens' CreateSnapshotSchedule (Prelude.Maybe Prelude.Bool)
createSnapshotSchedule_dryRun :: Lens' CreateSnapshotSchedule (Maybe Bool)
createSnapshotSchedule_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotSchedule' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateSnapshotSchedule
s@CreateSnapshotSchedule' {} Maybe Bool
a -> CreateSnapshotSchedule
s {$sel:dryRun:CreateSnapshotSchedule' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateSnapshotSchedule)

createSnapshotSchedule_nextInvocations :: Lens.Lens' CreateSnapshotSchedule (Prelude.Maybe Prelude.Int)
createSnapshotSchedule_nextInvocations :: Lens' CreateSnapshotSchedule (Maybe Int)
createSnapshotSchedule_nextInvocations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotSchedule' {Maybe Int
nextInvocations :: Maybe Int
$sel:nextInvocations:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Int
nextInvocations} -> Maybe Int
nextInvocations) (\s :: CreateSnapshotSchedule
s@CreateSnapshotSchedule' {} Maybe Int
a -> CreateSnapshotSchedule
s {$sel:nextInvocations:CreateSnapshotSchedule' :: Maybe Int
nextInvocations = Maybe Int
a} :: CreateSnapshotSchedule)

-- | The definition of the snapshot schedule. The definition is made up of
-- schedule expressions, for example \"cron(30 12 *)\" or \"rate(12
-- hours)\".
createSnapshotSchedule_scheduleDefinitions :: Lens.Lens' CreateSnapshotSchedule (Prelude.Maybe [Prelude.Text])
createSnapshotSchedule_scheduleDefinitions :: Lens' CreateSnapshotSchedule (Maybe [Text])
createSnapshotSchedule_scheduleDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotSchedule' {Maybe [Text]
scheduleDefinitions :: Maybe [Text]
$sel:scheduleDefinitions:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Text]
scheduleDefinitions} -> Maybe [Text]
scheduleDefinitions) (\s :: CreateSnapshotSchedule
s@CreateSnapshotSchedule' {} Maybe [Text]
a -> CreateSnapshotSchedule
s {$sel:scheduleDefinitions:CreateSnapshotSchedule' :: Maybe [Text]
scheduleDefinitions = Maybe [Text]
a} :: CreateSnapshotSchedule) 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 description of the snapshot schedule.
createSnapshotSchedule_scheduleDescription :: Lens.Lens' CreateSnapshotSchedule (Prelude.Maybe Prelude.Text)
createSnapshotSchedule_scheduleDescription :: Lens' CreateSnapshotSchedule (Maybe Text)
createSnapshotSchedule_scheduleDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotSchedule' {Maybe Text
scheduleDescription :: Maybe Text
$sel:scheduleDescription:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
scheduleDescription} -> Maybe Text
scheduleDescription) (\s :: CreateSnapshotSchedule
s@CreateSnapshotSchedule' {} Maybe Text
a -> CreateSnapshotSchedule
s {$sel:scheduleDescription:CreateSnapshotSchedule' :: Maybe Text
scheduleDescription = Maybe Text
a} :: CreateSnapshotSchedule)

-- | A unique identifier for a snapshot schedule. Only alphanumeric
-- characters are allowed for the identifier.
createSnapshotSchedule_scheduleIdentifier :: Lens.Lens' CreateSnapshotSchedule (Prelude.Maybe Prelude.Text)
createSnapshotSchedule_scheduleIdentifier :: Lens' CreateSnapshotSchedule (Maybe Text)
createSnapshotSchedule_scheduleIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotSchedule' {Maybe Text
scheduleIdentifier :: Maybe Text
$sel:scheduleIdentifier:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
scheduleIdentifier} -> Maybe Text
scheduleIdentifier) (\s :: CreateSnapshotSchedule
s@CreateSnapshotSchedule' {} Maybe Text
a -> CreateSnapshotSchedule
s {$sel:scheduleIdentifier:CreateSnapshotSchedule' :: Maybe Text
scheduleIdentifier = Maybe Text
a} :: CreateSnapshotSchedule)

-- | An optional set of tags you can use to search for the schedule.
createSnapshotSchedule_tags :: Lens.Lens' CreateSnapshotSchedule (Prelude.Maybe [Tag])
createSnapshotSchedule_tags :: Lens' CreateSnapshotSchedule (Maybe [Tag])
createSnapshotSchedule_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSnapshotSchedule' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateSnapshotSchedule
s@CreateSnapshotSchedule' {} Maybe [Tag]
a -> CreateSnapshotSchedule
s {$sel:tags:CreateSnapshotSchedule' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateSnapshotSchedule) 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

instance Core.AWSRequest CreateSnapshotSchedule where
  type
    AWSResponse CreateSnapshotSchedule =
      SnapshotSchedule
  request :: (Service -> Service)
-> CreateSnapshotSchedule -> Request CreateSnapshotSchedule
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 CreateSnapshotSchedule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateSnapshotSchedule)))
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
"CreateSnapshotScheduleResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable CreateSnapshotSchedule where
  hashWithSalt :: Int -> CreateSnapshotSchedule -> Int
hashWithSalt Int
_salt CreateSnapshotSchedule' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Tag]
Maybe Text
tags :: Maybe [Tag]
scheduleIdentifier :: Maybe Text
scheduleDescription :: Maybe Text
scheduleDefinitions :: Maybe [Text]
nextInvocations :: Maybe Int
dryRun :: Maybe Bool
$sel:tags:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Tag]
$sel:scheduleIdentifier:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
$sel:scheduleDescription:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
$sel:scheduleDefinitions:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Text]
$sel:nextInvocations:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Int
$sel:dryRun:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
nextInvocations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
scheduleDefinitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
scheduleDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
scheduleIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags

instance Prelude.NFData CreateSnapshotSchedule where
  rnf :: CreateSnapshotSchedule -> ()
rnf CreateSnapshotSchedule' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Tag]
Maybe Text
tags :: Maybe [Tag]
scheduleIdentifier :: Maybe Text
scheduleDescription :: Maybe Text
scheduleDefinitions :: Maybe [Text]
nextInvocations :: Maybe Int
dryRun :: Maybe Bool
$sel:tags:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Tag]
$sel:scheduleIdentifier:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
$sel:scheduleDescription:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
$sel:scheduleDefinitions:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Text]
$sel:nextInvocations:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Int
$sel:dryRun:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
nextInvocations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
scheduleDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scheduleDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scheduleIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags

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

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

instance Data.ToQuery CreateSnapshotSchedule where
  toQuery :: CreateSnapshotSchedule -> QueryString
toQuery CreateSnapshotSchedule' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Tag]
Maybe Text
tags :: Maybe [Tag]
scheduleIdentifier :: Maybe Text
scheduleDescription :: Maybe Text
scheduleDefinitions :: Maybe [Text]
nextInvocations :: Maybe Int
dryRun :: Maybe Bool
$sel:tags:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Tag]
$sel:scheduleIdentifier:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
$sel:scheduleDescription:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Text
$sel:scheduleDefinitions:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe [Text]
$sel:nextInvocations:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Int
$sel:dryRun:CreateSnapshotSchedule' :: CreateSnapshotSchedule -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateSnapshotSchedule" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"NextInvocations" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
nextInvocations,
        ByteString
"ScheduleDefinitions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"ScheduleDefinition"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
scheduleDefinitions
            ),
        ByteString
"ScheduleDescription" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
scheduleDescription,
        ByteString
"ScheduleIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
scheduleIdentifier,
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags)
      ]