{-# 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.ModifyCustomDBEngineVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the status of a custom engine version (CEV). You can find CEVs
-- to modify by calling @DescribeDBEngineVersions@.
--
-- The MediaImport service that imports files from Amazon S3 to create CEVs
-- isn\'t integrated with Amazon Web Services CloudTrail. If you turn on
-- data logging for Amazon RDS in CloudTrail, calls to the
-- @ModifyCustomDbEngineVersion@ event aren\'t logged. However, you might
-- see calls from the API gateway that accesses your Amazon S3 bucket.
-- These calls originate from the MediaImport service for the
-- @ModifyCustomDbEngineVersion@ event.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/custom-cev.html#custom-cev.modify Modifying CEV status>
-- in the /Amazon RDS User Guide/.
module Amazonka.RDS.ModifyCustomDBEngineVersion
  ( -- * Creating a Request
    ModifyCustomDBEngineVersion (..),
    newModifyCustomDBEngineVersion,

    -- * Request Lenses
    modifyCustomDBEngineVersion_description,
    modifyCustomDBEngineVersion_status,
    modifyCustomDBEngineVersion_engine,
    modifyCustomDBEngineVersion_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:/ 'newModifyCustomDBEngineVersion' smart constructor.
data ModifyCustomDBEngineVersion = ModifyCustomDBEngineVersion'
  { -- | An optional description of your CEV.
    ModifyCustomDBEngineVersion -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The availability status to be assigned to the CEV. Valid values are as
    -- follows:
    --
    -- [available]
    --     You can use this CEV to create a new RDS Custom DB instance.
    --
    -- [inactive]
    --     You can create a new RDS Custom instance by restoring a DB snapshot
    --     with this CEV. You can\'t patch or create new instances with this
    --     CEV.
    --
    -- You can change any status to any status. A typical reason to change
    -- status is to prevent the accidental use of a CEV, or to make a
    -- deprecated CEV eligible for use again. For example, you might change the
    -- status of your CEV from @available@ to @inactive@, and from @inactive@
    -- back to @available@. To change the availability status of the CEV, it
    -- must not currently be in use by an RDS Custom instance, snapshot, or
    -- automated backup.
    ModifyCustomDBEngineVersion -> Maybe CustomEngineVersionStatus
status :: Prelude.Maybe CustomEngineVersionStatus,
    -- | The DB engine. The only supported value is @custom-oracle-ee@.
    ModifyCustomDBEngineVersion -> Text
engine :: Prelude.Text,
    -- | The custom engine version (CEV) that you want to modify. This option is
    -- required for RDS Custom for Oracle, but optional for Amazon RDS. The
    -- combination of @Engine@ and @EngineVersion@ is unique per customer per
    -- Amazon Web Services Region.
    ModifyCustomDBEngineVersion -> Text
engineVersion :: Prelude.Text
  }
  deriving (ModifyCustomDBEngineVersion -> ModifyCustomDBEngineVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyCustomDBEngineVersion -> ModifyCustomDBEngineVersion -> Bool
$c/= :: ModifyCustomDBEngineVersion -> ModifyCustomDBEngineVersion -> Bool
== :: ModifyCustomDBEngineVersion -> ModifyCustomDBEngineVersion -> Bool
$c== :: ModifyCustomDBEngineVersion -> ModifyCustomDBEngineVersion -> Bool
Prelude.Eq, ReadPrec [ModifyCustomDBEngineVersion]
ReadPrec ModifyCustomDBEngineVersion
Int -> ReadS ModifyCustomDBEngineVersion
ReadS [ModifyCustomDBEngineVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyCustomDBEngineVersion]
$creadListPrec :: ReadPrec [ModifyCustomDBEngineVersion]
readPrec :: ReadPrec ModifyCustomDBEngineVersion
$creadPrec :: ReadPrec ModifyCustomDBEngineVersion
readList :: ReadS [ModifyCustomDBEngineVersion]
$creadList :: ReadS [ModifyCustomDBEngineVersion]
readsPrec :: Int -> ReadS ModifyCustomDBEngineVersion
$creadsPrec :: Int -> ReadS ModifyCustomDBEngineVersion
Prelude.Read, Int -> ModifyCustomDBEngineVersion -> ShowS
[ModifyCustomDBEngineVersion] -> ShowS
ModifyCustomDBEngineVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyCustomDBEngineVersion] -> ShowS
$cshowList :: [ModifyCustomDBEngineVersion] -> ShowS
show :: ModifyCustomDBEngineVersion -> String
$cshow :: ModifyCustomDBEngineVersion -> String
showsPrec :: Int -> ModifyCustomDBEngineVersion -> ShowS
$cshowsPrec :: Int -> ModifyCustomDBEngineVersion -> ShowS
Prelude.Show, forall x.
Rep ModifyCustomDBEngineVersion x -> ModifyCustomDBEngineVersion
forall x.
ModifyCustomDBEngineVersion -> Rep ModifyCustomDBEngineVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyCustomDBEngineVersion x -> ModifyCustomDBEngineVersion
$cfrom :: forall x.
ModifyCustomDBEngineVersion -> Rep ModifyCustomDBEngineVersion x
Prelude.Generic)

-- |
-- Create a value of 'ModifyCustomDBEngineVersion' 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:
--
-- 'description', 'modifyCustomDBEngineVersion_description' - An optional description of your CEV.
--
-- 'status', 'modifyCustomDBEngineVersion_status' - The availability status to be assigned to the CEV. Valid values are as
-- follows:
--
-- [available]
--     You can use this CEV to create a new RDS Custom DB instance.
--
-- [inactive]
--     You can create a new RDS Custom instance by restoring a DB snapshot
--     with this CEV. You can\'t patch or create new instances with this
--     CEV.
--
-- You can change any status to any status. A typical reason to change
-- status is to prevent the accidental use of a CEV, or to make a
-- deprecated CEV eligible for use again. For example, you might change the
-- status of your CEV from @available@ to @inactive@, and from @inactive@
-- back to @available@. To change the availability status of the CEV, it
-- must not currently be in use by an RDS Custom instance, snapshot, or
-- automated backup.
--
-- 'engine', 'modifyCustomDBEngineVersion_engine' - The DB engine. The only supported value is @custom-oracle-ee@.
--
-- 'engineVersion', 'modifyCustomDBEngineVersion_engineVersion' - The custom engine version (CEV) that you want to modify. This option is
-- required for RDS Custom for Oracle, but optional for Amazon RDS. The
-- combination of @Engine@ and @EngineVersion@ is unique per customer per
-- Amazon Web Services Region.
newModifyCustomDBEngineVersion ::
  -- | 'engine'
  Prelude.Text ->
  -- | 'engineVersion'
  Prelude.Text ->
  ModifyCustomDBEngineVersion
newModifyCustomDBEngineVersion :: Text -> Text -> ModifyCustomDBEngineVersion
newModifyCustomDBEngineVersion
  Text
pEngine_
  Text
pEngineVersion_ =
    ModifyCustomDBEngineVersion'
      { $sel:description:ModifyCustomDBEngineVersion' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:status:ModifyCustomDBEngineVersion' :: Maybe CustomEngineVersionStatus
status = forall a. Maybe a
Prelude.Nothing,
        $sel:engine:ModifyCustomDBEngineVersion' :: Text
engine = Text
pEngine_,
        $sel:engineVersion:ModifyCustomDBEngineVersion' :: Text
engineVersion = Text
pEngineVersion_
      }

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

-- | The availability status to be assigned to the CEV. Valid values are as
-- follows:
--
-- [available]
--     You can use this CEV to create a new RDS Custom DB instance.
--
-- [inactive]
--     You can create a new RDS Custom instance by restoring a DB snapshot
--     with this CEV. You can\'t patch or create new instances with this
--     CEV.
--
-- You can change any status to any status. A typical reason to change
-- status is to prevent the accidental use of a CEV, or to make a
-- deprecated CEV eligible for use again. For example, you might change the
-- status of your CEV from @available@ to @inactive@, and from @inactive@
-- back to @available@. To change the availability status of the CEV, it
-- must not currently be in use by an RDS Custom instance, snapshot, or
-- automated backup.
modifyCustomDBEngineVersion_status :: Lens.Lens' ModifyCustomDBEngineVersion (Prelude.Maybe CustomEngineVersionStatus)
modifyCustomDBEngineVersion_status :: Lens' ModifyCustomDBEngineVersion (Maybe CustomEngineVersionStatus)
modifyCustomDBEngineVersion_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCustomDBEngineVersion' {Maybe CustomEngineVersionStatus
status :: Maybe CustomEngineVersionStatus
$sel:status:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Maybe CustomEngineVersionStatus
status} -> Maybe CustomEngineVersionStatus
status) (\s :: ModifyCustomDBEngineVersion
s@ModifyCustomDBEngineVersion' {} Maybe CustomEngineVersionStatus
a -> ModifyCustomDBEngineVersion
s {$sel:status:ModifyCustomDBEngineVersion' :: Maybe CustomEngineVersionStatus
status = Maybe CustomEngineVersionStatus
a} :: ModifyCustomDBEngineVersion)

-- | The DB engine. The only supported value is @custom-oracle-ee@.
modifyCustomDBEngineVersion_engine :: Lens.Lens' ModifyCustomDBEngineVersion Prelude.Text
modifyCustomDBEngineVersion_engine :: Lens' ModifyCustomDBEngineVersion Text
modifyCustomDBEngineVersion_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCustomDBEngineVersion' {Text
engine :: Text
$sel:engine:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
engine} -> Text
engine) (\s :: ModifyCustomDBEngineVersion
s@ModifyCustomDBEngineVersion' {} Text
a -> ModifyCustomDBEngineVersion
s {$sel:engine:ModifyCustomDBEngineVersion' :: Text
engine = Text
a} :: ModifyCustomDBEngineVersion)

-- | The custom engine version (CEV) that you want to modify. This option is
-- required for RDS Custom for Oracle, but optional for Amazon RDS. The
-- combination of @Engine@ and @EngineVersion@ is unique per customer per
-- Amazon Web Services Region.
modifyCustomDBEngineVersion_engineVersion :: Lens.Lens' ModifyCustomDBEngineVersion Prelude.Text
modifyCustomDBEngineVersion_engineVersion :: Lens' ModifyCustomDBEngineVersion Text
modifyCustomDBEngineVersion_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCustomDBEngineVersion' {Text
engineVersion :: Text
$sel:engineVersion:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
engineVersion} -> Text
engineVersion) (\s :: ModifyCustomDBEngineVersion
s@ModifyCustomDBEngineVersion' {} Text
a -> ModifyCustomDBEngineVersion
s {$sel:engineVersion:ModifyCustomDBEngineVersion' :: Text
engineVersion = Text
a} :: ModifyCustomDBEngineVersion)

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

instance Prelude.Hashable ModifyCustomDBEngineVersion where
  hashWithSalt :: Int -> ModifyCustomDBEngineVersion -> Int
hashWithSalt Int
_salt ModifyCustomDBEngineVersion' {Maybe Text
Maybe CustomEngineVersionStatus
Text
engineVersion :: Text
engine :: Text
status :: Maybe CustomEngineVersionStatus
description :: Maybe Text
$sel:engineVersion:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
$sel:engine:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
$sel:status:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Maybe CustomEngineVersionStatus
$sel:description:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CustomEngineVersionStatus
status
      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 ModifyCustomDBEngineVersion where
  rnf :: ModifyCustomDBEngineVersion -> ()
rnf ModifyCustomDBEngineVersion' {Maybe Text
Maybe CustomEngineVersionStatus
Text
engineVersion :: Text
engine :: Text
status :: Maybe CustomEngineVersionStatus
description :: Maybe Text
$sel:engineVersion:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
$sel:engine:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
$sel:status:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Maybe CustomEngineVersionStatus
$sel:description:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Maybe Text
..} =
    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 CustomEngineVersionStatus
status
      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 ModifyCustomDBEngineVersion where
  toHeaders :: ModifyCustomDBEngineVersion -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyCustomDBEngineVersion where
  toQuery :: ModifyCustomDBEngineVersion -> QueryString
toQuery ModifyCustomDBEngineVersion' {Maybe Text
Maybe CustomEngineVersionStatus
Text
engineVersion :: Text
engine :: Text
status :: Maybe CustomEngineVersionStatus
description :: Maybe Text
$sel:engineVersion:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
$sel:engine:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Text
$sel:status:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Maybe CustomEngineVersionStatus
$sel:description:ModifyCustomDBEngineVersion' :: ModifyCustomDBEngineVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ModifyCustomDBEngineVersion" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"Status" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CustomEngineVersionStatus
status,
        ByteString
"Engine" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
engine,
        ByteString
"EngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
engineVersion
      ]