{-# 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.CreateCustomDBEngineVersion
-- 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 custom DB engine version (CEV).
module Amazonka.RDS.CreateCustomDBEngineVersion
  ( -- * Creating a Request
    CreateCustomDBEngineVersion (..),
    newCreateCustomDBEngineVersion,

    -- * Request Lenses
    createCustomDBEngineVersion_databaseInstallationFilesS3BucketName,
    createCustomDBEngineVersion_databaseInstallationFilesS3Prefix,
    createCustomDBEngineVersion_description,
    createCustomDBEngineVersion_imageId,
    createCustomDBEngineVersion_kmsKeyId,
    createCustomDBEngineVersion_manifest,
    createCustomDBEngineVersion_tags,
    createCustomDBEngineVersion_engine,
    createCustomDBEngineVersion_engineVersion,

    -- * Destructuring the Response
    DBEngineVersion (..),
    newDBEngineVersion,

    -- * Response Lenses
    dbEngineVersion_createTime,
    dbEngineVersion_customDBEngineVersionManifest,
    dbEngineVersion_dbEngineDescription,
    dbEngineVersion_dbEngineMediaType,
    dbEngineVersion_dbEngineVersionArn,
    dbEngineVersion_dbEngineVersionDescription,
    dbEngineVersion_dbParameterGroupFamily,
    dbEngineVersion_databaseInstallationFilesS3BucketName,
    dbEngineVersion_databaseInstallationFilesS3Prefix,
    dbEngineVersion_defaultCharacterSet,
    dbEngineVersion_engine,
    dbEngineVersion_engineVersion,
    dbEngineVersion_exportableLogTypes,
    dbEngineVersion_image,
    dbEngineVersion_kmsKeyId,
    dbEngineVersion_majorEngineVersion,
    dbEngineVersion_status,
    dbEngineVersion_supportedCACertificateIdentifiers,
    dbEngineVersion_supportedCharacterSets,
    dbEngineVersion_supportedEngineModes,
    dbEngineVersion_supportedFeatureNames,
    dbEngineVersion_supportedNcharCharacterSets,
    dbEngineVersion_supportedTimezones,
    dbEngineVersion_supportsBabelfish,
    dbEngineVersion_supportsCertificateRotationWithoutRestart,
    dbEngineVersion_supportsGlobalDatabases,
    dbEngineVersion_supportsLogExportsToCloudwatchLogs,
    dbEngineVersion_supportsParallelQuery,
    dbEngineVersion_supportsReadReplica,
    dbEngineVersion_tagList,
    dbEngineVersion_validUpgradeTarget,
  )
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:/ 'newCreateCustomDBEngineVersion' smart constructor.
data CreateCustomDBEngineVersion = CreateCustomDBEngineVersion'
  { -- | The name of an Amazon S3 bucket that contains database installation
    -- files for your CEV. For example, a valid bucket name is
    -- @my-custom-installation-files@.
    CreateCustomDBEngineVersion -> Maybe Text
databaseInstallationFilesS3BucketName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon S3 directory that contains the database installation files
    -- for your CEV. For example, a valid bucket name is @123456789012\/cev1@.
    -- If this setting isn\'t specified, no prefix is assumed.
    CreateCustomDBEngineVersion -> Maybe Text
databaseInstallationFilesS3Prefix :: Prelude.Maybe Prelude.Text,
    -- | An optional description of your CEV.
    CreateCustomDBEngineVersion -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ID of the AMI. An AMI ID is required to create a CEV for RDS Custom
    -- for SQL Server.
    CreateCustomDBEngineVersion -> Maybe Text
imageId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services KMS key identifier for an encrypted CEV. A
    -- symmetric encryption KMS key is required for RDS Custom, but optional
    -- for Amazon RDS.
    --
    -- If you have an existing symmetric encryption KMS key in your account,
    -- you can use it with RDS Custom. No further action is necessary. If you
    -- don\'t already have a symmetric encryption KMS key in your account,
    -- follow the instructions in
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html#create-symmetric-cmk Creating a symmetric encryption KMS key>
    -- in the /Amazon Web Services Key Management Service Developer Guide/.
    --
    -- You can choose the same symmetric encryption key when you create a CEV
    -- and a DB instance, or choose different keys.
    CreateCustomDBEngineVersion -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The CEV manifest, which is a JSON document that describes the
    -- installation .zip files stored in Amazon S3. Specify the name\/value
    -- pairs in a file or a quoted string. RDS Custom applies the patches in
    -- the order in which they are listed.
    --
    -- The following JSON fields are valid:
    --
    -- [MediaImportTemplateVersion]
    --     Version of the CEV manifest. The date is in the format @YYYY-MM-DD@.
    --
    -- [databaseInstallationFileNames]
    --     Ordered list of installation files for the CEV.
    --
    -- [opatchFileNames]
    --     Ordered list of OPatch installers used for the Oracle DB engine.
    --
    -- [psuRuPatchFileNames]
    --     The PSU and RU patches for this CEV.
    --
    -- [OtherPatchFileNames]
    --     The patches that are not in the list of PSU and RU patches. Amazon
    --     RDS applies these patches after applying the PSU and RU patches.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/custom-cev.html#custom-cev.preparing.manifest Creating the CEV manifest>
    -- in the /Amazon RDS User Guide/.
    CreateCustomDBEngineVersion -> Maybe Text
manifest :: Prelude.Maybe Prelude.Text,
    CreateCustomDBEngineVersion -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The database engine to use for your custom engine version (CEV). The
    -- only supported value is @custom-oracle-ee@.
    CreateCustomDBEngineVersion -> Text
engine :: Prelude.Text,
    -- | The name of your CEV. The name format is 19./customized_string/. For
    -- example, a valid CEV name is @19.my_cev1@. This setting is required for
    -- RDS Custom for Oracle, but optional for Amazon RDS. The combination of
    -- @Engine@ and @EngineVersion@ is unique per customer per Region.
    CreateCustomDBEngineVersion -> Text
engineVersion :: Prelude.Text
  }
  deriving (CreateCustomDBEngineVersion -> CreateCustomDBEngineVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCustomDBEngineVersion -> CreateCustomDBEngineVersion -> Bool
$c/= :: CreateCustomDBEngineVersion -> CreateCustomDBEngineVersion -> Bool
== :: CreateCustomDBEngineVersion -> CreateCustomDBEngineVersion -> Bool
$c== :: CreateCustomDBEngineVersion -> CreateCustomDBEngineVersion -> Bool
Prelude.Eq, ReadPrec [CreateCustomDBEngineVersion]
ReadPrec CreateCustomDBEngineVersion
Int -> ReadS CreateCustomDBEngineVersion
ReadS [CreateCustomDBEngineVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCustomDBEngineVersion]
$creadListPrec :: ReadPrec [CreateCustomDBEngineVersion]
readPrec :: ReadPrec CreateCustomDBEngineVersion
$creadPrec :: ReadPrec CreateCustomDBEngineVersion
readList :: ReadS [CreateCustomDBEngineVersion]
$creadList :: ReadS [CreateCustomDBEngineVersion]
readsPrec :: Int -> ReadS CreateCustomDBEngineVersion
$creadsPrec :: Int -> ReadS CreateCustomDBEngineVersion
Prelude.Read, Int -> CreateCustomDBEngineVersion -> ShowS
[CreateCustomDBEngineVersion] -> ShowS
CreateCustomDBEngineVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCustomDBEngineVersion] -> ShowS
$cshowList :: [CreateCustomDBEngineVersion] -> ShowS
show :: CreateCustomDBEngineVersion -> String
$cshow :: CreateCustomDBEngineVersion -> String
showsPrec :: Int -> CreateCustomDBEngineVersion -> ShowS
$cshowsPrec :: Int -> CreateCustomDBEngineVersion -> ShowS
Prelude.Show, forall x.
Rep CreateCustomDBEngineVersion x -> CreateCustomDBEngineVersion
forall x.
CreateCustomDBEngineVersion -> Rep CreateCustomDBEngineVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCustomDBEngineVersion x -> CreateCustomDBEngineVersion
$cfrom :: forall x.
CreateCustomDBEngineVersion -> Rep CreateCustomDBEngineVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateCustomDBEngineVersion' 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:
--
-- 'databaseInstallationFilesS3BucketName', 'createCustomDBEngineVersion_databaseInstallationFilesS3BucketName' - The name of an Amazon S3 bucket that contains database installation
-- files for your CEV. For example, a valid bucket name is
-- @my-custom-installation-files@.
--
-- 'databaseInstallationFilesS3Prefix', 'createCustomDBEngineVersion_databaseInstallationFilesS3Prefix' - The Amazon S3 directory that contains the database installation files
-- for your CEV. For example, a valid bucket name is @123456789012\/cev1@.
-- If this setting isn\'t specified, no prefix is assumed.
--
-- 'description', 'createCustomDBEngineVersion_description' - An optional description of your CEV.
--
-- 'imageId', 'createCustomDBEngineVersion_imageId' - The ID of the AMI. An AMI ID is required to create a CEV for RDS Custom
-- for SQL Server.
--
-- 'kmsKeyId', 'createCustomDBEngineVersion_kmsKeyId' - The Amazon Web Services KMS key identifier for an encrypted CEV. A
-- symmetric encryption KMS key is required for RDS Custom, but optional
-- for Amazon RDS.
--
-- If you have an existing symmetric encryption KMS key in your account,
-- you can use it with RDS Custom. No further action is necessary. If you
-- don\'t already have a symmetric encryption KMS key in your account,
-- follow the instructions in
-- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html#create-symmetric-cmk Creating a symmetric encryption KMS key>
-- in the /Amazon Web Services Key Management Service Developer Guide/.
--
-- You can choose the same symmetric encryption key when you create a CEV
-- and a DB instance, or choose different keys.
--
-- 'manifest', 'createCustomDBEngineVersion_manifest' - The CEV manifest, which is a JSON document that describes the
-- installation .zip files stored in Amazon S3. Specify the name\/value
-- pairs in a file or a quoted string. RDS Custom applies the patches in
-- the order in which they are listed.
--
-- The following JSON fields are valid:
--
-- [MediaImportTemplateVersion]
--     Version of the CEV manifest. The date is in the format @YYYY-MM-DD@.
--
-- [databaseInstallationFileNames]
--     Ordered list of installation files for the CEV.
--
-- [opatchFileNames]
--     Ordered list of OPatch installers used for the Oracle DB engine.
--
-- [psuRuPatchFileNames]
--     The PSU and RU patches for this CEV.
--
-- [OtherPatchFileNames]
--     The patches that are not in the list of PSU and RU patches. Amazon
--     RDS applies these patches after applying the PSU and RU patches.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/custom-cev.html#custom-cev.preparing.manifest Creating the CEV manifest>
-- in the /Amazon RDS User Guide/.
--
-- 'tags', 'createCustomDBEngineVersion_tags' - Undocumented member.
--
-- 'engine', 'createCustomDBEngineVersion_engine' - The database engine to use for your custom engine version (CEV). The
-- only supported value is @custom-oracle-ee@.
--
-- 'engineVersion', 'createCustomDBEngineVersion_engineVersion' - The name of your CEV. The name format is 19./customized_string/. For
-- example, a valid CEV name is @19.my_cev1@. This setting is required for
-- RDS Custom for Oracle, but optional for Amazon RDS. The combination of
-- @Engine@ and @EngineVersion@ is unique per customer per Region.
newCreateCustomDBEngineVersion ::
  -- | 'engine'
  Prelude.Text ->
  -- | 'engineVersion'
  Prelude.Text ->
  CreateCustomDBEngineVersion
newCreateCustomDBEngineVersion :: Text -> Text -> CreateCustomDBEngineVersion
newCreateCustomDBEngineVersion
  Text
pEngine_
  Text
pEngineVersion_ =
    CreateCustomDBEngineVersion'
      { $sel:databaseInstallationFilesS3BucketName:CreateCustomDBEngineVersion' :: Maybe Text
databaseInstallationFilesS3BucketName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:databaseInstallationFilesS3Prefix:CreateCustomDBEngineVersion' :: Maybe Text
databaseInstallationFilesS3Prefix =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateCustomDBEngineVersion' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:imageId:CreateCustomDBEngineVersion' :: Maybe Text
imageId = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CreateCustomDBEngineVersion' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:manifest:CreateCustomDBEngineVersion' :: Maybe Text
manifest = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCustomDBEngineVersion' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:engine:CreateCustomDBEngineVersion' :: Text
engine = Text
pEngine_,
        $sel:engineVersion:CreateCustomDBEngineVersion' :: Text
engineVersion = Text
pEngineVersion_
      }

-- | The name of an Amazon S3 bucket that contains database installation
-- files for your CEV. For example, a valid bucket name is
-- @my-custom-installation-files@.
createCustomDBEngineVersion_databaseInstallationFilesS3BucketName :: Lens.Lens' CreateCustomDBEngineVersion (Prelude.Maybe Prelude.Text)
createCustomDBEngineVersion_databaseInstallationFilesS3BucketName :: Lens' CreateCustomDBEngineVersion (Maybe Text)
createCustomDBEngineVersion_databaseInstallationFilesS3BucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Maybe Text
databaseInstallationFilesS3BucketName :: Maybe Text
$sel:databaseInstallationFilesS3BucketName:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
databaseInstallationFilesS3BucketName} -> Maybe Text
databaseInstallationFilesS3BucketName) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Maybe Text
a -> CreateCustomDBEngineVersion
s {$sel:databaseInstallationFilesS3BucketName:CreateCustomDBEngineVersion' :: Maybe Text
databaseInstallationFilesS3BucketName = Maybe Text
a} :: CreateCustomDBEngineVersion)

-- | The Amazon S3 directory that contains the database installation files
-- for your CEV. For example, a valid bucket name is @123456789012\/cev1@.
-- If this setting isn\'t specified, no prefix is assumed.
createCustomDBEngineVersion_databaseInstallationFilesS3Prefix :: Lens.Lens' CreateCustomDBEngineVersion (Prelude.Maybe Prelude.Text)
createCustomDBEngineVersion_databaseInstallationFilesS3Prefix :: Lens' CreateCustomDBEngineVersion (Maybe Text)
createCustomDBEngineVersion_databaseInstallationFilesS3Prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Maybe Text
databaseInstallationFilesS3Prefix :: Maybe Text
$sel:databaseInstallationFilesS3Prefix:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
databaseInstallationFilesS3Prefix} -> Maybe Text
databaseInstallationFilesS3Prefix) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Maybe Text
a -> CreateCustomDBEngineVersion
s {$sel:databaseInstallationFilesS3Prefix:CreateCustomDBEngineVersion' :: Maybe Text
databaseInstallationFilesS3Prefix = Maybe Text
a} :: CreateCustomDBEngineVersion)

-- | An optional description of your CEV.
createCustomDBEngineVersion_description :: Lens.Lens' CreateCustomDBEngineVersion (Prelude.Maybe Prelude.Text)
createCustomDBEngineVersion_description :: Lens' CreateCustomDBEngineVersion (Maybe Text)
createCustomDBEngineVersion_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Maybe Text
description :: Maybe Text
$sel:description:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Maybe Text
a -> CreateCustomDBEngineVersion
s {$sel:description:CreateCustomDBEngineVersion' :: Maybe Text
description = Maybe Text
a} :: CreateCustomDBEngineVersion)

-- | The ID of the AMI. An AMI ID is required to create a CEV for RDS Custom
-- for SQL Server.
createCustomDBEngineVersion_imageId :: Lens.Lens' CreateCustomDBEngineVersion (Prelude.Maybe Prelude.Text)
createCustomDBEngineVersion_imageId :: Lens' CreateCustomDBEngineVersion (Maybe Text)
createCustomDBEngineVersion_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Maybe Text
imageId :: Maybe Text
$sel:imageId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
imageId} -> Maybe Text
imageId) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Maybe Text
a -> CreateCustomDBEngineVersion
s {$sel:imageId:CreateCustomDBEngineVersion' :: Maybe Text
imageId = Maybe Text
a} :: CreateCustomDBEngineVersion)

-- | The Amazon Web Services KMS key identifier for an encrypted CEV. A
-- symmetric encryption KMS key is required for RDS Custom, but optional
-- for Amazon RDS.
--
-- If you have an existing symmetric encryption KMS key in your account,
-- you can use it with RDS Custom. No further action is necessary. If you
-- don\'t already have a symmetric encryption KMS key in your account,
-- follow the instructions in
-- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html#create-symmetric-cmk Creating a symmetric encryption KMS key>
-- in the /Amazon Web Services Key Management Service Developer Guide/.
--
-- You can choose the same symmetric encryption key when you create a CEV
-- and a DB instance, or choose different keys.
createCustomDBEngineVersion_kmsKeyId :: Lens.Lens' CreateCustomDBEngineVersion (Prelude.Maybe Prelude.Text)
createCustomDBEngineVersion_kmsKeyId :: Lens' CreateCustomDBEngineVersion (Maybe Text)
createCustomDBEngineVersion_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Maybe Text
a -> CreateCustomDBEngineVersion
s {$sel:kmsKeyId:CreateCustomDBEngineVersion' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateCustomDBEngineVersion)

-- | The CEV manifest, which is a JSON document that describes the
-- installation .zip files stored in Amazon S3. Specify the name\/value
-- pairs in a file or a quoted string. RDS Custom applies the patches in
-- the order in which they are listed.
--
-- The following JSON fields are valid:
--
-- [MediaImportTemplateVersion]
--     Version of the CEV manifest. The date is in the format @YYYY-MM-DD@.
--
-- [databaseInstallationFileNames]
--     Ordered list of installation files for the CEV.
--
-- [opatchFileNames]
--     Ordered list of OPatch installers used for the Oracle DB engine.
--
-- [psuRuPatchFileNames]
--     The PSU and RU patches for this CEV.
--
-- [OtherPatchFileNames]
--     The patches that are not in the list of PSU and RU patches. Amazon
--     RDS applies these patches after applying the PSU and RU patches.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/custom-cev.html#custom-cev.preparing.manifest Creating the CEV manifest>
-- in the /Amazon RDS User Guide/.
createCustomDBEngineVersion_manifest :: Lens.Lens' CreateCustomDBEngineVersion (Prelude.Maybe Prelude.Text)
createCustomDBEngineVersion_manifest :: Lens' CreateCustomDBEngineVersion (Maybe Text)
createCustomDBEngineVersion_manifest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Maybe Text
manifest :: Maybe Text
$sel:manifest:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
manifest} -> Maybe Text
manifest) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Maybe Text
a -> CreateCustomDBEngineVersion
s {$sel:manifest:CreateCustomDBEngineVersion' :: Maybe Text
manifest = Maybe Text
a} :: CreateCustomDBEngineVersion)

-- | Undocumented member.
createCustomDBEngineVersion_tags :: Lens.Lens' CreateCustomDBEngineVersion (Prelude.Maybe [Tag])
createCustomDBEngineVersion_tags :: Lens' CreateCustomDBEngineVersion (Maybe [Tag])
createCustomDBEngineVersion_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Maybe [Tag]
a -> CreateCustomDBEngineVersion
s {$sel:tags:CreateCustomDBEngineVersion' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCustomDBEngineVersion) 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 database engine to use for your custom engine version (CEV). The
-- only supported value is @custom-oracle-ee@.
createCustomDBEngineVersion_engine :: Lens.Lens' CreateCustomDBEngineVersion Prelude.Text
createCustomDBEngineVersion_engine :: Lens' CreateCustomDBEngineVersion Text
createCustomDBEngineVersion_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Text
engine :: Text
$sel:engine:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
engine} -> Text
engine) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Text
a -> CreateCustomDBEngineVersion
s {$sel:engine:CreateCustomDBEngineVersion' :: Text
engine = Text
a} :: CreateCustomDBEngineVersion)

-- | The name of your CEV. The name format is 19./customized_string/. For
-- example, a valid CEV name is @19.my_cev1@. This setting is required for
-- RDS Custom for Oracle, but optional for Amazon RDS. The combination of
-- @Engine@ and @EngineVersion@ is unique per customer per Region.
createCustomDBEngineVersion_engineVersion :: Lens.Lens' CreateCustomDBEngineVersion Prelude.Text
createCustomDBEngineVersion_engineVersion :: Lens' CreateCustomDBEngineVersion Text
createCustomDBEngineVersion_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDBEngineVersion' {Text
engineVersion :: Text
$sel:engineVersion:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
engineVersion} -> Text
engineVersion) (\s :: CreateCustomDBEngineVersion
s@CreateCustomDBEngineVersion' {} Text
a -> CreateCustomDBEngineVersion
s {$sel:engineVersion:CreateCustomDBEngineVersion' :: Text
engineVersion = Text
a} :: CreateCustomDBEngineVersion)

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

instance Prelude.Hashable CreateCustomDBEngineVersion where
  hashWithSalt :: Int -> CreateCustomDBEngineVersion -> Int
hashWithSalt Int
_salt CreateCustomDBEngineVersion' {Maybe [Tag]
Maybe Text
Text
engineVersion :: Text
engine :: Text
tags :: Maybe [Tag]
manifest :: Maybe Text
kmsKeyId :: Maybe Text
imageId :: Maybe Text
description :: Maybe Text
databaseInstallationFilesS3Prefix :: Maybe Text
databaseInstallationFilesS3BucketName :: Maybe Text
$sel:engineVersion:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
$sel:engine:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
$sel:tags:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe [Tag]
$sel:manifest:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:kmsKeyId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:imageId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:description:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:databaseInstallationFilesS3Prefix:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:databaseInstallationFilesS3BucketName:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
databaseInstallationFilesS3BucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
databaseInstallationFilesS3Prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
manifest
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
engineVersion

instance Prelude.NFData CreateCustomDBEngineVersion where
  rnf :: CreateCustomDBEngineVersion -> ()
rnf CreateCustomDBEngineVersion' {Maybe [Tag]
Maybe Text
Text
engineVersion :: Text
engine :: Text
tags :: Maybe [Tag]
manifest :: Maybe Text
kmsKeyId :: Maybe Text
imageId :: Maybe Text
description :: Maybe Text
databaseInstallationFilesS3Prefix :: Maybe Text
databaseInstallationFilesS3BucketName :: Maybe Text
$sel:engineVersion:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
$sel:engine:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
$sel:tags:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe [Tag]
$sel:manifest:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:kmsKeyId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:imageId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:description:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:databaseInstallationFilesS3Prefix:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:databaseInstallationFilesS3BucketName:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
databaseInstallationFilesS3BucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
databaseInstallationFilesS3Prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
manifest
      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
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
engineVersion

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

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

instance Data.ToQuery CreateCustomDBEngineVersion where
  toQuery :: CreateCustomDBEngineVersion -> QueryString
toQuery CreateCustomDBEngineVersion' {Maybe [Tag]
Maybe Text
Text
engineVersion :: Text
engine :: Text
tags :: Maybe [Tag]
manifest :: Maybe Text
kmsKeyId :: Maybe Text
imageId :: Maybe Text
description :: Maybe Text
databaseInstallationFilesS3Prefix :: Maybe Text
databaseInstallationFilesS3BucketName :: Maybe Text
$sel:engineVersion:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
$sel:engine:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Text
$sel:tags:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe [Tag]
$sel:manifest:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:kmsKeyId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:imageId:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:description:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:databaseInstallationFilesS3Prefix:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
$sel:databaseInstallationFilesS3BucketName:CreateCustomDBEngineVersion' :: CreateCustomDBEngineVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateCustomDBEngineVersion" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DatabaseInstallationFilesS3BucketName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
databaseInstallationFilesS3BucketName,
        ByteString
"DatabaseInstallationFilesS3Prefix"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
databaseInstallationFilesS3Prefix,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"ImageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
imageId,
        ByteString
"KMSKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        ByteString
"Manifest" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
manifest,
        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
"Engine" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
engine,
        ByteString
"EngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
engineVersion
      ]