{-# 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.RDS.CreateDBSnapshot
-- 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 snapshot of a DB instance. The source DB instance must be in
-- the @available@ or @storage-optimization@ state.
module Amazonka.RDS.CreateDBSnapshot
  ( -- * Creating a Request
    CreateDBSnapshot (..),
    newCreateDBSnapshot,

    -- * Request Lenses
    createDBSnapshot_tags,
    createDBSnapshot_dbSnapshotIdentifier,
    createDBSnapshot_dbInstanceIdentifier,

    -- * Destructuring the Response
    CreateDBSnapshotResponse (..),
    newCreateDBSnapshotResponse,

    -- * Response Lenses
    createDBSnapshotResponse_dbSnapshot,
    createDBSnapshotResponse_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.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newCreateDBSnapshot' smart constructor.
data CreateDBSnapshot = CreateDBSnapshot'
  { CreateDBSnapshot -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier for the DB snapshot.
    --
    -- Constraints:
    --
    -- -   Can\'t be null, empty, or blank
    --
    -- -   Must contain from 1 to 255 letters, numbers, or hyphens
    --
    -- -   First character must be a letter
    --
    -- -   Can\'t end with a hyphen or contain two consecutive hyphens
    --
    -- Example: @my-snapshot-id@
    CreateDBSnapshot -> Text
dbSnapshotIdentifier :: Prelude.Text,
    -- | The identifier of the DB instance that you want to create the snapshot
    -- of.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DBInstance.
    CreateDBSnapshot -> Text
dbInstanceIdentifier :: Prelude.Text
  }
  deriving (CreateDBSnapshot -> CreateDBSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDBSnapshot -> CreateDBSnapshot -> Bool
$c/= :: CreateDBSnapshot -> CreateDBSnapshot -> Bool
== :: CreateDBSnapshot -> CreateDBSnapshot -> Bool
$c== :: CreateDBSnapshot -> CreateDBSnapshot -> Bool
Prelude.Eq, ReadPrec [CreateDBSnapshot]
ReadPrec CreateDBSnapshot
Int -> ReadS CreateDBSnapshot
ReadS [CreateDBSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDBSnapshot]
$creadListPrec :: ReadPrec [CreateDBSnapshot]
readPrec :: ReadPrec CreateDBSnapshot
$creadPrec :: ReadPrec CreateDBSnapshot
readList :: ReadS [CreateDBSnapshot]
$creadList :: ReadS [CreateDBSnapshot]
readsPrec :: Int -> ReadS CreateDBSnapshot
$creadsPrec :: Int -> ReadS CreateDBSnapshot
Prelude.Read, Int -> CreateDBSnapshot -> ShowS
[CreateDBSnapshot] -> ShowS
CreateDBSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDBSnapshot] -> ShowS
$cshowList :: [CreateDBSnapshot] -> ShowS
show :: CreateDBSnapshot -> String
$cshow :: CreateDBSnapshot -> String
showsPrec :: Int -> CreateDBSnapshot -> ShowS
$cshowsPrec :: Int -> CreateDBSnapshot -> ShowS
Prelude.Show, forall x. Rep CreateDBSnapshot x -> CreateDBSnapshot
forall x. CreateDBSnapshot -> Rep CreateDBSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDBSnapshot x -> CreateDBSnapshot
$cfrom :: forall x. CreateDBSnapshot -> Rep CreateDBSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'CreateDBSnapshot' 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:
--
-- 'tags', 'createDBSnapshot_tags' - Undocumented member.
--
-- 'dbSnapshotIdentifier', 'createDBSnapshot_dbSnapshotIdentifier' - The identifier for the DB snapshot.
--
-- Constraints:
--
-- -   Can\'t be null, empty, or blank
--
-- -   Must contain from 1 to 255 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-snapshot-id@
--
-- 'dbInstanceIdentifier', 'createDBSnapshot_dbInstanceIdentifier' - The identifier of the DB instance that you want to create the snapshot
-- of.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBInstance.
newCreateDBSnapshot ::
  -- | 'dbSnapshotIdentifier'
  Prelude.Text ->
  -- | 'dbInstanceIdentifier'
  Prelude.Text ->
  CreateDBSnapshot
newCreateDBSnapshot :: Text -> Text -> CreateDBSnapshot
newCreateDBSnapshot
  Text
pDBSnapshotIdentifier_
  Text
pDBInstanceIdentifier_ =
    CreateDBSnapshot'
      { $sel:tags:CreateDBSnapshot' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:dbSnapshotIdentifier:CreateDBSnapshot' :: Text
dbSnapshotIdentifier = Text
pDBSnapshotIdentifier_,
        $sel:dbInstanceIdentifier:CreateDBSnapshot' :: Text
dbInstanceIdentifier = Text
pDBInstanceIdentifier_
      }

-- | Undocumented member.
createDBSnapshot_tags :: Lens.Lens' CreateDBSnapshot (Prelude.Maybe [Tag])
createDBSnapshot_tags :: Lens' CreateDBSnapshot (Maybe [Tag])
createDBSnapshot_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBSnapshot' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDBSnapshot' :: CreateDBSnapshot -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDBSnapshot
s@CreateDBSnapshot' {} Maybe [Tag]
a -> CreateDBSnapshot
s {$sel:tags:CreateDBSnapshot' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDBSnapshot) 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 identifier for the DB snapshot.
--
-- Constraints:
--
-- -   Can\'t be null, empty, or blank
--
-- -   Must contain from 1 to 255 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-snapshot-id@
createDBSnapshot_dbSnapshotIdentifier :: Lens.Lens' CreateDBSnapshot Prelude.Text
createDBSnapshot_dbSnapshotIdentifier :: Lens' CreateDBSnapshot Text
createDBSnapshot_dbSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBSnapshot' {Text
dbSnapshotIdentifier :: Text
$sel:dbSnapshotIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
dbSnapshotIdentifier} -> Text
dbSnapshotIdentifier) (\s :: CreateDBSnapshot
s@CreateDBSnapshot' {} Text
a -> CreateDBSnapshot
s {$sel:dbSnapshotIdentifier:CreateDBSnapshot' :: Text
dbSnapshotIdentifier = Text
a} :: CreateDBSnapshot)

-- | The identifier of the DB instance that you want to create the snapshot
-- of.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBInstance.
createDBSnapshot_dbInstanceIdentifier :: Lens.Lens' CreateDBSnapshot Prelude.Text
createDBSnapshot_dbInstanceIdentifier :: Lens' CreateDBSnapshot Text
createDBSnapshot_dbInstanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBSnapshot' {Text
dbInstanceIdentifier :: Text
$sel:dbInstanceIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
dbInstanceIdentifier} -> Text
dbInstanceIdentifier) (\s :: CreateDBSnapshot
s@CreateDBSnapshot' {} Text
a -> CreateDBSnapshot
s {$sel:dbInstanceIdentifier:CreateDBSnapshot' :: Text
dbInstanceIdentifier = Text
a} :: CreateDBSnapshot)

instance Core.AWSRequest CreateDBSnapshot where
  type
    AWSResponse CreateDBSnapshot =
      CreateDBSnapshotResponse
  request :: (Service -> Service)
-> CreateDBSnapshot -> Request CreateDBSnapshot
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 CreateDBSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDBSnapshot)))
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
"CreateDBSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBSnapshot -> Int -> CreateDBSnapshotResponse
CreateDBSnapshotResponse'
            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
"DBSnapshot")
            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 CreateDBSnapshot where
  hashWithSalt :: Int -> CreateDBSnapshot -> Int
hashWithSalt Int
_salt CreateDBSnapshot' {Maybe [Tag]
Text
dbInstanceIdentifier :: Text
dbSnapshotIdentifier :: Text
tags :: Maybe [Tag]
$sel:dbInstanceIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
$sel:dbSnapshotIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
$sel:tags:CreateDBSnapshot' :: CreateDBSnapshot -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbSnapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbInstanceIdentifier

instance Prelude.NFData CreateDBSnapshot where
  rnf :: CreateDBSnapshot -> ()
rnf CreateDBSnapshot' {Maybe [Tag]
Text
dbInstanceIdentifier :: Text
dbSnapshotIdentifier :: Text
tags :: Maybe [Tag]
$sel:dbInstanceIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
$sel:dbSnapshotIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
$sel:tags:CreateDBSnapshot' :: CreateDBSnapshot -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbSnapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbInstanceIdentifier

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

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

instance Data.ToQuery CreateDBSnapshot where
  toQuery :: CreateDBSnapshot -> QueryString
toQuery CreateDBSnapshot' {Maybe [Tag]
Text
dbInstanceIdentifier :: Text
dbSnapshotIdentifier :: Text
tags :: Maybe [Tag]
$sel:dbInstanceIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
$sel:dbSnapshotIdentifier:CreateDBSnapshot' :: CreateDBSnapshot -> Text
$sel:tags:CreateDBSnapshot' :: CreateDBSnapshot -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateDBSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        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),
        ByteString
"DBSnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbSnapshotIdentifier,
        ByteString
"DBInstanceIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbInstanceIdentifier
      ]

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

-- |
-- Create a value of 'CreateDBSnapshotResponse' 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:
--
-- 'dbSnapshot', 'createDBSnapshotResponse_dbSnapshot' - Undocumented member.
--
-- 'httpStatus', 'createDBSnapshotResponse_httpStatus' - The response's http status code.
newCreateDBSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDBSnapshotResponse
newCreateDBSnapshotResponse :: Int -> CreateDBSnapshotResponse
newCreateDBSnapshotResponse Int
pHttpStatus_ =
  CreateDBSnapshotResponse'
    { $sel:dbSnapshot:CreateDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDBSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createDBSnapshotResponse_dbSnapshot :: Lens.Lens' CreateDBSnapshotResponse (Prelude.Maybe DBSnapshot)
createDBSnapshotResponse_dbSnapshot :: Lens' CreateDBSnapshotResponse (Maybe DBSnapshot)
createDBSnapshotResponse_dbSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDBSnapshotResponse' {Maybe DBSnapshot
dbSnapshot :: Maybe DBSnapshot
$sel:dbSnapshot:CreateDBSnapshotResponse' :: CreateDBSnapshotResponse -> Maybe DBSnapshot
dbSnapshot} -> Maybe DBSnapshot
dbSnapshot) (\s :: CreateDBSnapshotResponse
s@CreateDBSnapshotResponse' {} Maybe DBSnapshot
a -> CreateDBSnapshotResponse
s {$sel:dbSnapshot:CreateDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot = Maybe DBSnapshot
a} :: CreateDBSnapshotResponse)

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

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