{-# 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.Lightsail.CreateRelationalDatabase
-- 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 database in Amazon Lightsail.
--
-- The @create relational database@ operation supports tag-based access
-- control via request tags. For more information, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-controlling-access-using-tags Amazon Lightsail Developer Guide>.
module Amazonka.Lightsail.CreateRelationalDatabase
  ( -- * Creating a Request
    CreateRelationalDatabase (..),
    newCreateRelationalDatabase,

    -- * Request Lenses
    createRelationalDatabase_availabilityZone,
    createRelationalDatabase_masterUserPassword,
    createRelationalDatabase_preferredBackupWindow,
    createRelationalDatabase_preferredMaintenanceWindow,
    createRelationalDatabase_publiclyAccessible,
    createRelationalDatabase_tags,
    createRelationalDatabase_relationalDatabaseName,
    createRelationalDatabase_relationalDatabaseBlueprintId,
    createRelationalDatabase_relationalDatabaseBundleId,
    createRelationalDatabase_masterDatabaseName,
    createRelationalDatabase_masterUsername,

    -- * Destructuring the Response
    CreateRelationalDatabaseResponse (..),
    newCreateRelationalDatabaseResponse,

    -- * Response Lenses
    createRelationalDatabaseResponse_operations,
    createRelationalDatabaseResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateRelationalDatabase' smart constructor.
data CreateRelationalDatabase = CreateRelationalDatabase'
  { -- | The Availability Zone in which to create your new database. Use the
    -- @us-east-2a@ case-sensitive format.
    --
    -- You can get a list of Availability Zones by using the @get regions@
    -- operation. Be sure to add the
    -- @include relational database Availability Zones@ parameter to your
    -- request.
    CreateRelationalDatabase -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The password for the master user. The password can include any printable
    -- ASCII character except \"\/\", \"\"\", or \"\@\". It cannot contain
    -- spaces.
    --
    -- __MySQL__
    --
    -- Constraints: Must contain from 8 to 41 characters.
    --
    -- __PostgreSQL__
    --
    -- Constraints: Must contain from 8 to 128 characters.
    CreateRelationalDatabase -> Maybe (Sensitive Text)
masterUserPassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The daily time range during which automated backups are created for your
    -- new database if automated backups are enabled.
    --
    -- The default is a 30-minute window selected at random from an 8-hour
    -- block of time for each AWS Region. For more information about the
    -- preferred backup window time blocks for each region, see the
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_WorkingWithAutomatedBackups.html#USER_WorkingWithAutomatedBackups.BackupWindow Working With Backups>
    -- guide in the Amazon Relational Database Service documentation.
    --
    -- Constraints:
    --
    -- -   Must be in the @hh24:mi-hh24:mi@ format.
    --
    --     Example: @16:00-16:30@
    --
    -- -   Specified in Coordinated Universal Time (UTC).
    --
    -- -   Must not conflict with the preferred maintenance window.
    --
    -- -   Must be at least 30 minutes.
    CreateRelationalDatabase -> Maybe Text
preferredBackupWindow :: Prelude.Maybe Prelude.Text,
    -- | The weekly time range during which system maintenance can occur on your
    -- new database.
    --
    -- The default is a 30-minute window selected at random from an 8-hour
    -- block of time for each AWS Region, occurring on a random day of the
    -- week.
    --
    -- Constraints:
    --
    -- -   Must be in the @ddd:hh24:mi-ddd:hh24:mi@ format.
    --
    -- -   Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
    --
    -- -   Must be at least 30 minutes.
    --
    -- -   Specified in Coordinated Universal Time (UTC).
    --
    -- -   Example: @Tue:17:00-Tue:17:30@
    CreateRelationalDatabase -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | Specifies the accessibility options for your new database. A value of
    -- @true@ specifies a database that is available to resources outside of
    -- your Lightsail account. A value of @false@ specifies a database that is
    -- available only to your Lightsail resources in the same region as your
    -- database.
    CreateRelationalDatabase -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | The tag keys and optional values to add to the resource during create.
    --
    -- Use the @TagResource@ action to tag a resource after it\'s created.
    CreateRelationalDatabase -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name to use for your new Lightsail database resource.
    --
    -- Constraints:
    --
    -- -   Must contain from 2 to 255 alphanumeric characters, or hyphens.
    --
    -- -   The first and last character must be a letter or number.
    CreateRelationalDatabase -> Text
relationalDatabaseName :: Prelude.Text,
    -- | The blueprint ID for your new database. A blueprint describes the major
    -- engine version of a database.
    --
    -- You can get a list of database blueprints IDs by using the
    -- @get relational database blueprints@ operation.
    CreateRelationalDatabase -> Text
relationalDatabaseBlueprintId :: Prelude.Text,
    -- | The bundle ID for your new database. A bundle describes the performance
    -- specifications for your database.
    --
    -- You can get a list of database bundle IDs by using the
    -- @get relational database bundles@ operation.
    CreateRelationalDatabase -> Text
relationalDatabaseBundleId :: Prelude.Text,
    -- | The meaning of this parameter differs according to the database engine
    -- you use.
    --
    -- __MySQL__
    --
    -- The name of the database to create when the Lightsail database resource
    -- is created. If this parameter isn\'t specified, no database is created
    -- in the database resource.
    --
    -- Constraints:
    --
    -- -   Must contain 1 to 64 letters or numbers.
    --
    -- -   Must begin with a letter. Subsequent characters can be letters,
    --     underscores, or digits (0- 9).
    --
    -- -   Can\'t be a word reserved by the specified database engine.
    --
    --     For more information about reserved words in MySQL, see the Keywords
    --     and Reserved Words articles for
    --     <https://dev.mysql.com/doc/refman/5.6/en/keywords.html MySQL 5.6>,
    --     <https://dev.mysql.com/doc/refman/5.7/en/keywords.html MySQL 5.7>,
    --     and
    --     <https://dev.mysql.com/doc/refman/8.0/en/keywords.html MySQL 8.0>.
    --
    -- __PostgreSQL__
    --
    -- The name of the database to create when the Lightsail database resource
    -- is created. If this parameter isn\'t specified, a database named
    -- @postgres@ is created in the database resource.
    --
    -- Constraints:
    --
    -- -   Must contain 1 to 63 letters or numbers.
    --
    -- -   Must begin with a letter. Subsequent characters can be letters,
    --     underscores, or digits (0- 9).
    --
    -- -   Can\'t be a word reserved by the specified database engine.
    --
    --     For more information about reserved words in PostgreSQL, see the SQL
    --     Key Words articles for
    --     <https://www.postgresql.org/docs/9.6/sql-keywords-appendix.html PostgreSQL 9.6>,
    --     <https://www.postgresql.org/docs/10/sql-keywords-appendix.html PostgreSQL 10>,
    --     <https://www.postgresql.org/docs/11/sql-keywords-appendix.html PostgreSQL 11>,
    --     and
    --     <https://www.postgresql.org/docs/12/sql-keywords-appendix.html PostgreSQL 12>.
    CreateRelationalDatabase -> Text
masterDatabaseName :: Prelude.Text,
    -- | The name for the master user.
    --
    -- __MySQL__
    --
    -- Constraints:
    --
    -- -   Required for MySQL.
    --
    -- -   Must be 1 to 16 letters or numbers. Can contain underscores.
    --
    -- -   First character must be a letter.
    --
    -- -   Can\'t be a reserved word for the chosen database engine.
    --
    --     For more information about reserved words in MySQL 5.6 or 5.7, see
    --     the Keywords and Reserved Words articles for
    --     <https://dev.mysql.com/doc/refman/5.6/en/keywords.html MySQL 5.6>,
    --     <https://dev.mysql.com/doc/refman/5.7/en/keywords.html MySQL 5.7>,
    --     or
    --     <https://dev.mysql.com/doc/refman/8.0/en/keywords.html MySQL 8.0>.
    --
    -- __PostgreSQL__
    --
    -- Constraints:
    --
    -- -   Required for PostgreSQL.
    --
    -- -   Must be 1 to 63 letters or numbers. Can contain underscores.
    --
    -- -   First character must be a letter.
    --
    -- -   Can\'t be a reserved word for the chosen database engine.
    --
    --     For more information about reserved words in MySQL 5.6 or 5.7, see
    --     the Keywords and Reserved Words articles for
    --     <https://www.postgresql.org/docs/9.6/sql-keywords-appendix.html PostgreSQL 9.6>,
    --     <https://www.postgresql.org/docs/10/sql-keywords-appendix.html PostgreSQL 10>,
    --     <https://www.postgresql.org/docs/11/sql-keywords-appendix.html PostgreSQL 11>,
    --     and
    --     <https://www.postgresql.org/docs/12/sql-keywords-appendix.html PostgreSQL 12>.
    CreateRelationalDatabase -> Text
masterUsername :: Prelude.Text
  }
  deriving (CreateRelationalDatabase -> CreateRelationalDatabase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRelationalDatabase -> CreateRelationalDatabase -> Bool
$c/= :: CreateRelationalDatabase -> CreateRelationalDatabase -> Bool
== :: CreateRelationalDatabase -> CreateRelationalDatabase -> Bool
$c== :: CreateRelationalDatabase -> CreateRelationalDatabase -> Bool
Prelude.Eq, Int -> CreateRelationalDatabase -> ShowS
[CreateRelationalDatabase] -> ShowS
CreateRelationalDatabase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRelationalDatabase] -> ShowS
$cshowList :: [CreateRelationalDatabase] -> ShowS
show :: CreateRelationalDatabase -> String
$cshow :: CreateRelationalDatabase -> String
showsPrec :: Int -> CreateRelationalDatabase -> ShowS
$cshowsPrec :: Int -> CreateRelationalDatabase -> ShowS
Prelude.Show, forall x.
Rep CreateRelationalDatabase x -> CreateRelationalDatabase
forall x.
CreateRelationalDatabase -> Rep CreateRelationalDatabase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateRelationalDatabase x -> CreateRelationalDatabase
$cfrom :: forall x.
CreateRelationalDatabase -> Rep CreateRelationalDatabase x
Prelude.Generic)

-- |
-- Create a value of 'CreateRelationalDatabase' 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:
--
-- 'availabilityZone', 'createRelationalDatabase_availabilityZone' - The Availability Zone in which to create your new database. Use the
-- @us-east-2a@ case-sensitive format.
--
-- You can get a list of Availability Zones by using the @get regions@
-- operation. Be sure to add the
-- @include relational database Availability Zones@ parameter to your
-- request.
--
-- 'masterUserPassword', 'createRelationalDatabase_masterUserPassword' - The password for the master user. The password can include any printable
-- ASCII character except \"\/\", \"\"\", or \"\@\". It cannot contain
-- spaces.
--
-- __MySQL__
--
-- Constraints: Must contain from 8 to 41 characters.
--
-- __PostgreSQL__
--
-- Constraints: Must contain from 8 to 128 characters.
--
-- 'preferredBackupWindow', 'createRelationalDatabase_preferredBackupWindow' - The daily time range during which automated backups are created for your
-- new database if automated backups are enabled.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each AWS Region. For more information about the
-- preferred backup window time blocks for each region, see the
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_WorkingWithAutomatedBackups.html#USER_WorkingWithAutomatedBackups.BackupWindow Working With Backups>
-- guide in the Amazon Relational Database Service documentation.
--
-- Constraints:
--
-- -   Must be in the @hh24:mi-hh24:mi@ format.
--
--     Example: @16:00-16:30@
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Must not conflict with the preferred maintenance window.
--
-- -   Must be at least 30 minutes.
--
-- 'preferredMaintenanceWindow', 'createRelationalDatabase_preferredMaintenanceWindow' - The weekly time range during which system maintenance can occur on your
-- new database.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each AWS Region, occurring on a random day of the
-- week.
--
-- Constraints:
--
-- -   Must be in the @ddd:hh24:mi-ddd:hh24:mi@ format.
--
-- -   Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
--
-- -   Must be at least 30 minutes.
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Example: @Tue:17:00-Tue:17:30@
--
-- 'publiclyAccessible', 'createRelationalDatabase_publiclyAccessible' - Specifies the accessibility options for your new database. A value of
-- @true@ specifies a database that is available to resources outside of
-- your Lightsail account. A value of @false@ specifies a database that is
-- available only to your Lightsail resources in the same region as your
-- database.
--
-- 'tags', 'createRelationalDatabase_tags' - The tag keys and optional values to add to the resource during create.
--
-- Use the @TagResource@ action to tag a resource after it\'s created.
--
-- 'relationalDatabaseName', 'createRelationalDatabase_relationalDatabaseName' - The name to use for your new Lightsail database resource.
--
-- Constraints:
--
-- -   Must contain from 2 to 255 alphanumeric characters, or hyphens.
--
-- -   The first and last character must be a letter or number.
--
-- 'relationalDatabaseBlueprintId', 'createRelationalDatabase_relationalDatabaseBlueprintId' - The blueprint ID for your new database. A blueprint describes the major
-- engine version of a database.
--
-- You can get a list of database blueprints IDs by using the
-- @get relational database blueprints@ operation.
--
-- 'relationalDatabaseBundleId', 'createRelationalDatabase_relationalDatabaseBundleId' - The bundle ID for your new database. A bundle describes the performance
-- specifications for your database.
--
-- You can get a list of database bundle IDs by using the
-- @get relational database bundles@ operation.
--
-- 'masterDatabaseName', 'createRelationalDatabase_masterDatabaseName' - The meaning of this parameter differs according to the database engine
-- you use.
--
-- __MySQL__
--
-- The name of the database to create when the Lightsail database resource
-- is created. If this parameter isn\'t specified, no database is created
-- in the database resource.
--
-- Constraints:
--
-- -   Must contain 1 to 64 letters or numbers.
--
-- -   Must begin with a letter. Subsequent characters can be letters,
--     underscores, or digits (0- 9).
--
-- -   Can\'t be a word reserved by the specified database engine.
--
--     For more information about reserved words in MySQL, see the Keywords
--     and Reserved Words articles for
--     <https://dev.mysql.com/doc/refman/5.6/en/keywords.html MySQL 5.6>,
--     <https://dev.mysql.com/doc/refman/5.7/en/keywords.html MySQL 5.7>,
--     and
--     <https://dev.mysql.com/doc/refman/8.0/en/keywords.html MySQL 8.0>.
--
-- __PostgreSQL__
--
-- The name of the database to create when the Lightsail database resource
-- is created. If this parameter isn\'t specified, a database named
-- @postgres@ is created in the database resource.
--
-- Constraints:
--
-- -   Must contain 1 to 63 letters or numbers.
--
-- -   Must begin with a letter. Subsequent characters can be letters,
--     underscores, or digits (0- 9).
--
-- -   Can\'t be a word reserved by the specified database engine.
--
--     For more information about reserved words in PostgreSQL, see the SQL
--     Key Words articles for
--     <https://www.postgresql.org/docs/9.6/sql-keywords-appendix.html PostgreSQL 9.6>,
--     <https://www.postgresql.org/docs/10/sql-keywords-appendix.html PostgreSQL 10>,
--     <https://www.postgresql.org/docs/11/sql-keywords-appendix.html PostgreSQL 11>,
--     and
--     <https://www.postgresql.org/docs/12/sql-keywords-appendix.html PostgreSQL 12>.
--
-- 'masterUsername', 'createRelationalDatabase_masterUsername' - The name for the master user.
--
-- __MySQL__
--
-- Constraints:
--
-- -   Required for MySQL.
--
-- -   Must be 1 to 16 letters or numbers. Can contain underscores.
--
-- -   First character must be a letter.
--
-- -   Can\'t be a reserved word for the chosen database engine.
--
--     For more information about reserved words in MySQL 5.6 or 5.7, see
--     the Keywords and Reserved Words articles for
--     <https://dev.mysql.com/doc/refman/5.6/en/keywords.html MySQL 5.6>,
--     <https://dev.mysql.com/doc/refman/5.7/en/keywords.html MySQL 5.7>,
--     or
--     <https://dev.mysql.com/doc/refman/8.0/en/keywords.html MySQL 8.0>.
--
-- __PostgreSQL__
--
-- Constraints:
--
-- -   Required for PostgreSQL.
--
-- -   Must be 1 to 63 letters or numbers. Can contain underscores.
--
-- -   First character must be a letter.
--
-- -   Can\'t be a reserved word for the chosen database engine.
--
--     For more information about reserved words in MySQL 5.6 or 5.7, see
--     the Keywords and Reserved Words articles for
--     <https://www.postgresql.org/docs/9.6/sql-keywords-appendix.html PostgreSQL 9.6>,
--     <https://www.postgresql.org/docs/10/sql-keywords-appendix.html PostgreSQL 10>,
--     <https://www.postgresql.org/docs/11/sql-keywords-appendix.html PostgreSQL 11>,
--     and
--     <https://www.postgresql.org/docs/12/sql-keywords-appendix.html PostgreSQL 12>.
newCreateRelationalDatabase ::
  -- | 'relationalDatabaseName'
  Prelude.Text ->
  -- | 'relationalDatabaseBlueprintId'
  Prelude.Text ->
  -- | 'relationalDatabaseBundleId'
  Prelude.Text ->
  -- | 'masterDatabaseName'
  Prelude.Text ->
  -- | 'masterUsername'
  Prelude.Text ->
  CreateRelationalDatabase
newCreateRelationalDatabase :: Text -> Text -> Text -> Text -> Text -> CreateRelationalDatabase
newCreateRelationalDatabase
  Text
pRelationalDatabaseName_
  Text
pRelationalDatabaseBlueprintId_
  Text
pRelationalDatabaseBundleId_
  Text
pMasterDatabaseName_
  Text
pMasterUsername_ =
    CreateRelationalDatabase'
      { $sel:availabilityZone:CreateRelationalDatabase' :: Maybe Text
availabilityZone =
          forall a. Maybe a
Prelude.Nothing,
        $sel:masterUserPassword:CreateRelationalDatabase' :: Maybe (Sensitive Text)
masterUserPassword = forall a. Maybe a
Prelude.Nothing,
        $sel:preferredBackupWindow:CreateRelationalDatabase' :: Maybe Text
preferredBackupWindow = forall a. Maybe a
Prelude.Nothing,
        $sel:preferredMaintenanceWindow:CreateRelationalDatabase' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
        $sel:publiclyAccessible:CreateRelationalDatabase' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateRelationalDatabase' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:relationalDatabaseName:CreateRelationalDatabase' :: Text
relationalDatabaseName = Text
pRelationalDatabaseName_,
        $sel:relationalDatabaseBlueprintId:CreateRelationalDatabase' :: Text
relationalDatabaseBlueprintId =
          Text
pRelationalDatabaseBlueprintId_,
        $sel:relationalDatabaseBundleId:CreateRelationalDatabase' :: Text
relationalDatabaseBundleId =
          Text
pRelationalDatabaseBundleId_,
        $sel:masterDatabaseName:CreateRelationalDatabase' :: Text
masterDatabaseName = Text
pMasterDatabaseName_,
        $sel:masterUsername:CreateRelationalDatabase' :: Text
masterUsername = Text
pMasterUsername_
      }

-- | The Availability Zone in which to create your new database. Use the
-- @us-east-2a@ case-sensitive format.
--
-- You can get a list of Availability Zones by using the @get regions@
-- operation. Be sure to add the
-- @include relational database Availability Zones@ parameter to your
-- request.
createRelationalDatabase_availabilityZone :: Lens.Lens' CreateRelationalDatabase (Prelude.Maybe Prelude.Text)
createRelationalDatabase_availabilityZone :: Lens' CreateRelationalDatabase (Maybe Text)
createRelationalDatabase_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Maybe Text
a -> CreateRelationalDatabase
s {$sel:availabilityZone:CreateRelationalDatabase' :: Maybe Text
availabilityZone = Maybe Text
a} :: CreateRelationalDatabase)

-- | The password for the master user. The password can include any printable
-- ASCII character except \"\/\", \"\"\", or \"\@\". It cannot contain
-- spaces.
--
-- __MySQL__
--
-- Constraints: Must contain from 8 to 41 characters.
--
-- __PostgreSQL__
--
-- Constraints: Must contain from 8 to 128 characters.
createRelationalDatabase_masterUserPassword :: Lens.Lens' CreateRelationalDatabase (Prelude.Maybe Prelude.Text)
createRelationalDatabase_masterUserPassword :: Lens' CreateRelationalDatabase (Maybe Text)
createRelationalDatabase_masterUserPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Maybe (Sensitive Text)
masterUserPassword :: Maybe (Sensitive Text)
$sel:masterUserPassword:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe (Sensitive Text)
masterUserPassword} -> Maybe (Sensitive Text)
masterUserPassword) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Maybe (Sensitive Text)
a -> CreateRelationalDatabase
s {$sel:masterUserPassword:CreateRelationalDatabase' :: Maybe (Sensitive Text)
masterUserPassword = Maybe (Sensitive Text)
a} :: CreateRelationalDatabase) 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

-- | The daily time range during which automated backups are created for your
-- new database if automated backups are enabled.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each AWS Region. For more information about the
-- preferred backup window time blocks for each region, see the
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_WorkingWithAutomatedBackups.html#USER_WorkingWithAutomatedBackups.BackupWindow Working With Backups>
-- guide in the Amazon Relational Database Service documentation.
--
-- Constraints:
--
-- -   Must be in the @hh24:mi-hh24:mi@ format.
--
--     Example: @16:00-16:30@
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Must not conflict with the preferred maintenance window.
--
-- -   Must be at least 30 minutes.
createRelationalDatabase_preferredBackupWindow :: Lens.Lens' CreateRelationalDatabase (Prelude.Maybe Prelude.Text)
createRelationalDatabase_preferredBackupWindow :: Lens' CreateRelationalDatabase (Maybe Text)
createRelationalDatabase_preferredBackupWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Maybe Text
preferredBackupWindow :: Maybe Text
$sel:preferredBackupWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
preferredBackupWindow} -> Maybe Text
preferredBackupWindow) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Maybe Text
a -> CreateRelationalDatabase
s {$sel:preferredBackupWindow:CreateRelationalDatabase' :: Maybe Text
preferredBackupWindow = Maybe Text
a} :: CreateRelationalDatabase)

-- | The weekly time range during which system maintenance can occur on your
-- new database.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each AWS Region, occurring on a random day of the
-- week.
--
-- Constraints:
--
-- -   Must be in the @ddd:hh24:mi-ddd:hh24:mi@ format.
--
-- -   Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
--
-- -   Must be at least 30 minutes.
--
-- -   Specified in Coordinated Universal Time (UTC).
--
-- -   Example: @Tue:17:00-Tue:17:30@
createRelationalDatabase_preferredMaintenanceWindow :: Lens.Lens' CreateRelationalDatabase (Prelude.Maybe Prelude.Text)
createRelationalDatabase_preferredMaintenanceWindow :: Lens' CreateRelationalDatabase (Maybe Text)
createRelationalDatabase_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Maybe Text
a -> CreateRelationalDatabase
s {$sel:preferredMaintenanceWindow:CreateRelationalDatabase' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: CreateRelationalDatabase)

-- | Specifies the accessibility options for your new database. A value of
-- @true@ specifies a database that is available to resources outside of
-- your Lightsail account. A value of @false@ specifies a database that is
-- available only to your Lightsail resources in the same region as your
-- database.
createRelationalDatabase_publiclyAccessible :: Lens.Lens' CreateRelationalDatabase (Prelude.Maybe Prelude.Bool)
createRelationalDatabase_publiclyAccessible :: Lens' CreateRelationalDatabase (Maybe Bool)
createRelationalDatabase_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Maybe Bool
a -> CreateRelationalDatabase
s {$sel:publiclyAccessible:CreateRelationalDatabase' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: CreateRelationalDatabase)

-- | The tag keys and optional values to add to the resource during create.
--
-- Use the @TagResource@ action to tag a resource after it\'s created.
createRelationalDatabase_tags :: Lens.Lens' CreateRelationalDatabase (Prelude.Maybe [Tag])
createRelationalDatabase_tags :: Lens' CreateRelationalDatabase (Maybe [Tag])
createRelationalDatabase_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Maybe [Tag]
a -> CreateRelationalDatabase
s {$sel:tags:CreateRelationalDatabase' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateRelationalDatabase) 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 name to use for your new Lightsail database resource.
--
-- Constraints:
--
-- -   Must contain from 2 to 255 alphanumeric characters, or hyphens.
--
-- -   The first and last character must be a letter or number.
createRelationalDatabase_relationalDatabaseName :: Lens.Lens' CreateRelationalDatabase Prelude.Text
createRelationalDatabase_relationalDatabaseName :: Lens' CreateRelationalDatabase Text
createRelationalDatabase_relationalDatabaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Text
relationalDatabaseName :: Text
$sel:relationalDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
relationalDatabaseName} -> Text
relationalDatabaseName) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Text
a -> CreateRelationalDatabase
s {$sel:relationalDatabaseName:CreateRelationalDatabase' :: Text
relationalDatabaseName = Text
a} :: CreateRelationalDatabase)

-- | The blueprint ID for your new database. A blueprint describes the major
-- engine version of a database.
--
-- You can get a list of database blueprints IDs by using the
-- @get relational database blueprints@ operation.
createRelationalDatabase_relationalDatabaseBlueprintId :: Lens.Lens' CreateRelationalDatabase Prelude.Text
createRelationalDatabase_relationalDatabaseBlueprintId :: Lens' CreateRelationalDatabase Text
createRelationalDatabase_relationalDatabaseBlueprintId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Text
relationalDatabaseBlueprintId :: Text
$sel:relationalDatabaseBlueprintId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
relationalDatabaseBlueprintId} -> Text
relationalDatabaseBlueprintId) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Text
a -> CreateRelationalDatabase
s {$sel:relationalDatabaseBlueprintId:CreateRelationalDatabase' :: Text
relationalDatabaseBlueprintId = Text
a} :: CreateRelationalDatabase)

-- | The bundle ID for your new database. A bundle describes the performance
-- specifications for your database.
--
-- You can get a list of database bundle IDs by using the
-- @get relational database bundles@ operation.
createRelationalDatabase_relationalDatabaseBundleId :: Lens.Lens' CreateRelationalDatabase Prelude.Text
createRelationalDatabase_relationalDatabaseBundleId :: Lens' CreateRelationalDatabase Text
createRelationalDatabase_relationalDatabaseBundleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Text
relationalDatabaseBundleId :: Text
$sel:relationalDatabaseBundleId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
relationalDatabaseBundleId} -> Text
relationalDatabaseBundleId) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Text
a -> CreateRelationalDatabase
s {$sel:relationalDatabaseBundleId:CreateRelationalDatabase' :: Text
relationalDatabaseBundleId = Text
a} :: CreateRelationalDatabase)

-- | The meaning of this parameter differs according to the database engine
-- you use.
--
-- __MySQL__
--
-- The name of the database to create when the Lightsail database resource
-- is created. If this parameter isn\'t specified, no database is created
-- in the database resource.
--
-- Constraints:
--
-- -   Must contain 1 to 64 letters or numbers.
--
-- -   Must begin with a letter. Subsequent characters can be letters,
--     underscores, or digits (0- 9).
--
-- -   Can\'t be a word reserved by the specified database engine.
--
--     For more information about reserved words in MySQL, see the Keywords
--     and Reserved Words articles for
--     <https://dev.mysql.com/doc/refman/5.6/en/keywords.html MySQL 5.6>,
--     <https://dev.mysql.com/doc/refman/5.7/en/keywords.html MySQL 5.7>,
--     and
--     <https://dev.mysql.com/doc/refman/8.0/en/keywords.html MySQL 8.0>.
--
-- __PostgreSQL__
--
-- The name of the database to create when the Lightsail database resource
-- is created. If this parameter isn\'t specified, a database named
-- @postgres@ is created in the database resource.
--
-- Constraints:
--
-- -   Must contain 1 to 63 letters or numbers.
--
-- -   Must begin with a letter. Subsequent characters can be letters,
--     underscores, or digits (0- 9).
--
-- -   Can\'t be a word reserved by the specified database engine.
--
--     For more information about reserved words in PostgreSQL, see the SQL
--     Key Words articles for
--     <https://www.postgresql.org/docs/9.6/sql-keywords-appendix.html PostgreSQL 9.6>,
--     <https://www.postgresql.org/docs/10/sql-keywords-appendix.html PostgreSQL 10>,
--     <https://www.postgresql.org/docs/11/sql-keywords-appendix.html PostgreSQL 11>,
--     and
--     <https://www.postgresql.org/docs/12/sql-keywords-appendix.html PostgreSQL 12>.
createRelationalDatabase_masterDatabaseName :: Lens.Lens' CreateRelationalDatabase Prelude.Text
createRelationalDatabase_masterDatabaseName :: Lens' CreateRelationalDatabase Text
createRelationalDatabase_masterDatabaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Text
masterDatabaseName :: Text
$sel:masterDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
masterDatabaseName} -> Text
masterDatabaseName) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Text
a -> CreateRelationalDatabase
s {$sel:masterDatabaseName:CreateRelationalDatabase' :: Text
masterDatabaseName = Text
a} :: CreateRelationalDatabase)

-- | The name for the master user.
--
-- __MySQL__
--
-- Constraints:
--
-- -   Required for MySQL.
--
-- -   Must be 1 to 16 letters or numbers. Can contain underscores.
--
-- -   First character must be a letter.
--
-- -   Can\'t be a reserved word for the chosen database engine.
--
--     For more information about reserved words in MySQL 5.6 or 5.7, see
--     the Keywords and Reserved Words articles for
--     <https://dev.mysql.com/doc/refman/5.6/en/keywords.html MySQL 5.6>,
--     <https://dev.mysql.com/doc/refman/5.7/en/keywords.html MySQL 5.7>,
--     or
--     <https://dev.mysql.com/doc/refman/8.0/en/keywords.html MySQL 8.0>.
--
-- __PostgreSQL__
--
-- Constraints:
--
-- -   Required for PostgreSQL.
--
-- -   Must be 1 to 63 letters or numbers. Can contain underscores.
--
-- -   First character must be a letter.
--
-- -   Can\'t be a reserved word for the chosen database engine.
--
--     For more information about reserved words in MySQL 5.6 or 5.7, see
--     the Keywords and Reserved Words articles for
--     <https://www.postgresql.org/docs/9.6/sql-keywords-appendix.html PostgreSQL 9.6>,
--     <https://www.postgresql.org/docs/10/sql-keywords-appendix.html PostgreSQL 10>,
--     <https://www.postgresql.org/docs/11/sql-keywords-appendix.html PostgreSQL 11>,
--     and
--     <https://www.postgresql.org/docs/12/sql-keywords-appendix.html PostgreSQL 12>.
createRelationalDatabase_masterUsername :: Lens.Lens' CreateRelationalDatabase Prelude.Text
createRelationalDatabase_masterUsername :: Lens' CreateRelationalDatabase Text
createRelationalDatabase_masterUsername = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabase' {Text
masterUsername :: Text
$sel:masterUsername:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
masterUsername} -> Text
masterUsername) (\s :: CreateRelationalDatabase
s@CreateRelationalDatabase' {} Text
a -> CreateRelationalDatabase
s {$sel:masterUsername:CreateRelationalDatabase' :: Text
masterUsername = Text
a} :: CreateRelationalDatabase)

instance Core.AWSRequest CreateRelationalDatabase where
  type
    AWSResponse CreateRelationalDatabase =
      CreateRelationalDatabaseResponse
  request :: (Service -> Service)
-> CreateRelationalDatabase -> Request CreateRelationalDatabase
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 CreateRelationalDatabase
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateRelationalDatabase)))
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 [Operation] -> Int -> CreateRelationalDatabaseResponse
CreateRelationalDatabaseResponse'
            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
"operations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 CreateRelationalDatabase where
  hashWithSalt :: Int -> CreateRelationalDatabase -> Int
hashWithSalt Int
_salt CreateRelationalDatabase' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
masterUsername :: Text
masterDatabaseName :: Text
relationalDatabaseBundleId :: Text
relationalDatabaseBlueprintId :: Text
relationalDatabaseName :: Text
tags :: Maybe [Tag]
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
masterUserPassword :: Maybe (Sensitive Text)
availabilityZone :: Maybe Text
$sel:masterUsername:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:masterDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseBundleId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseBlueprintId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:tags:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe [Tag]
$sel:publiclyAccessible:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Bool
$sel:preferredMaintenanceWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
$sel:preferredBackupWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
$sel:masterUserPassword:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe (Sensitive Text)
$sel:availabilityZone:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
masterUserPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredBackupWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
publiclyAccessible
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
relationalDatabaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
relationalDatabaseBlueprintId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
relationalDatabaseBundleId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
masterDatabaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
masterUsername

instance Prelude.NFData CreateRelationalDatabase where
  rnf :: CreateRelationalDatabase -> ()
rnf CreateRelationalDatabase' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
masterUsername :: Text
masterDatabaseName :: Text
relationalDatabaseBundleId :: Text
relationalDatabaseBlueprintId :: Text
relationalDatabaseName :: Text
tags :: Maybe [Tag]
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
masterUserPassword :: Maybe (Sensitive Text)
availabilityZone :: Maybe Text
$sel:masterUsername:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:masterDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseBundleId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseBlueprintId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:tags:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe [Tag]
$sel:publiclyAccessible:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Bool
$sel:preferredMaintenanceWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
$sel:preferredBackupWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
$sel:masterUserPassword:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe (Sensitive Text)
$sel:availabilityZone:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
masterUserPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredBackupWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
publiclyAccessible
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
relationalDatabaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
relationalDatabaseBlueprintId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
relationalDatabaseBundleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
masterDatabaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
masterUsername

instance Data.ToHeaders CreateRelationalDatabase where
  toHeaders :: CreateRelationalDatabase -> 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
"Lightsail_20161128.CreateRelationalDatabase" ::
                          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 CreateRelationalDatabase where
  toJSON :: CreateRelationalDatabase -> Value
toJSON CreateRelationalDatabase' {Maybe Bool
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
masterUsername :: Text
masterDatabaseName :: Text
relationalDatabaseBundleId :: Text
relationalDatabaseBlueprintId :: Text
relationalDatabaseName :: Text
tags :: Maybe [Tag]
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
masterUserPassword :: Maybe (Sensitive Text)
availabilityZone :: Maybe Text
$sel:masterUsername:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:masterDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseBundleId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseBlueprintId:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:relationalDatabaseName:CreateRelationalDatabase' :: CreateRelationalDatabase -> Text
$sel:tags:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe [Tag]
$sel:publiclyAccessible:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Bool
$sel:preferredMaintenanceWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
$sel:preferredBackupWindow:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
$sel:masterUserPassword:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe (Sensitive Text)
$sel:availabilityZone:CreateRelationalDatabase' :: CreateRelationalDatabase -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"availabilityZone" 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
availabilityZone,
            (Key
"masterUserPassword" 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)
masterUserPassword,
            (Key
"preferredBackupWindow" 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
preferredBackupWindow,
            (Key
"preferredMaintenanceWindow" 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
preferredMaintenanceWindow,
            (Key
"publiclyAccessible" 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 Bool
publiclyAccessible,
            (Key
"tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"relationalDatabaseName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
relationalDatabaseName
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"relationalDatabaseBlueprintId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
relationalDatabaseBlueprintId
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"relationalDatabaseBundleId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
relationalDatabaseBundleId
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"masterDatabaseName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
masterDatabaseName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"masterUsername" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
masterUsername)
          ]
      )

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

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

-- | /See:/ 'newCreateRelationalDatabaseResponse' smart constructor.
data CreateRelationalDatabaseResponse = CreateRelationalDatabaseResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    CreateRelationalDatabaseResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    CreateRelationalDatabaseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateRelationalDatabaseResponse
-> CreateRelationalDatabaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRelationalDatabaseResponse
-> CreateRelationalDatabaseResponse -> Bool
$c/= :: CreateRelationalDatabaseResponse
-> CreateRelationalDatabaseResponse -> Bool
== :: CreateRelationalDatabaseResponse
-> CreateRelationalDatabaseResponse -> Bool
$c== :: CreateRelationalDatabaseResponse
-> CreateRelationalDatabaseResponse -> Bool
Prelude.Eq, ReadPrec [CreateRelationalDatabaseResponse]
ReadPrec CreateRelationalDatabaseResponse
Int -> ReadS CreateRelationalDatabaseResponse
ReadS [CreateRelationalDatabaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRelationalDatabaseResponse]
$creadListPrec :: ReadPrec [CreateRelationalDatabaseResponse]
readPrec :: ReadPrec CreateRelationalDatabaseResponse
$creadPrec :: ReadPrec CreateRelationalDatabaseResponse
readList :: ReadS [CreateRelationalDatabaseResponse]
$creadList :: ReadS [CreateRelationalDatabaseResponse]
readsPrec :: Int -> ReadS CreateRelationalDatabaseResponse
$creadsPrec :: Int -> ReadS CreateRelationalDatabaseResponse
Prelude.Read, Int -> CreateRelationalDatabaseResponse -> ShowS
[CreateRelationalDatabaseResponse] -> ShowS
CreateRelationalDatabaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRelationalDatabaseResponse] -> ShowS
$cshowList :: [CreateRelationalDatabaseResponse] -> ShowS
show :: CreateRelationalDatabaseResponse -> String
$cshow :: CreateRelationalDatabaseResponse -> String
showsPrec :: Int -> CreateRelationalDatabaseResponse -> ShowS
$cshowsPrec :: Int -> CreateRelationalDatabaseResponse -> ShowS
Prelude.Show, forall x.
Rep CreateRelationalDatabaseResponse x
-> CreateRelationalDatabaseResponse
forall x.
CreateRelationalDatabaseResponse
-> Rep CreateRelationalDatabaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateRelationalDatabaseResponse x
-> CreateRelationalDatabaseResponse
$cfrom :: forall x.
CreateRelationalDatabaseResponse
-> Rep CreateRelationalDatabaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateRelationalDatabaseResponse' 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:
--
-- 'operations', 'createRelationalDatabaseResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'createRelationalDatabaseResponse_httpStatus' - The response's http status code.
newCreateRelationalDatabaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateRelationalDatabaseResponse
newCreateRelationalDatabaseResponse :: Int -> CreateRelationalDatabaseResponse
newCreateRelationalDatabaseResponse Int
pHttpStatus_ =
  CreateRelationalDatabaseResponse'
    { $sel:operations:CreateRelationalDatabaseResponse' :: Maybe [Operation]
operations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateRelationalDatabaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
createRelationalDatabaseResponse_operations :: Lens.Lens' CreateRelationalDatabaseResponse (Prelude.Maybe [Operation])
createRelationalDatabaseResponse_operations :: Lens' CreateRelationalDatabaseResponse (Maybe [Operation])
createRelationalDatabaseResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabaseResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:CreateRelationalDatabaseResponse' :: CreateRelationalDatabaseResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: CreateRelationalDatabaseResponse
s@CreateRelationalDatabaseResponse' {} Maybe [Operation]
a -> CreateRelationalDatabaseResponse
s {$sel:operations:CreateRelationalDatabaseResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: CreateRelationalDatabaseResponse) 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.
createRelationalDatabaseResponse_httpStatus :: Lens.Lens' CreateRelationalDatabaseResponse Prelude.Int
createRelationalDatabaseResponse_httpStatus :: Lens' CreateRelationalDatabaseResponse Int
createRelationalDatabaseResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRelationalDatabaseResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateRelationalDatabaseResponse' :: CreateRelationalDatabaseResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateRelationalDatabaseResponse
s@CreateRelationalDatabaseResponse' {} Int
a -> CreateRelationalDatabaseResponse
s {$sel:httpStatus:CreateRelationalDatabaseResponse' :: Int
httpStatus = Int
a} :: CreateRelationalDatabaseResponse)

instance
  Prelude.NFData
    CreateRelationalDatabaseResponse
  where
  rnf :: CreateRelationalDatabaseResponse -> ()
rnf CreateRelationalDatabaseResponse' {Int
Maybe [Operation]
httpStatus :: Int
operations :: Maybe [Operation]
$sel:httpStatus:CreateRelationalDatabaseResponse' :: CreateRelationalDatabaseResponse -> Int
$sel:operations:CreateRelationalDatabaseResponse' :: CreateRelationalDatabaseResponse -> Maybe [Operation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Operation]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus