{-# 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.ModifyCertificates
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Override the system-default Secure Sockets Layer\/Transport Layer
-- Security (SSL\/TLS) certificate for Amazon RDS for new DB instances, or
-- remove the override.
--
-- By using this operation, you can specify an RDS-approved SSL\/TLS
-- certificate for new DB instances that is different from the default
-- certificate provided by RDS. You can also use this operation to remove
-- the override, so that new DB instances use the default certificate
-- provided by RDS.
--
-- You might need to override the default certificate in the following
-- situations:
--
-- -   You already migrated your applications to support the latest
--     certificate authority (CA) certificate, but the new CA certificate
--     is not yet the RDS default CA certificate for the specified Amazon
--     Web Services Region.
--
-- -   RDS has already moved to a new default CA certificate for the
--     specified Amazon Web Services Region, but you are still in the
--     process of supporting the new CA certificate. In this case, you
--     temporarily need additional time to finish your application changes.
--
-- For more information about rotating your SSL\/TLS certificate for RDS DB
-- engines, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/UsingWithRDS.SSL-certificate-rotation.html Rotating Your SSL\/TLS Certificate>
-- in the /Amazon RDS User Guide/.
--
-- For more information about rotating your SSL\/TLS certificate for Aurora
-- DB engines, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/UsingWithRDS.SSL-certificate-rotation.html Rotating Your SSL\/TLS Certificate>
-- in the /Amazon Aurora User Guide/.
module Amazonka.RDS.ModifyCertificates
  ( -- * Creating a Request
    ModifyCertificates (..),
    newModifyCertificates,

    -- * Request Lenses
    modifyCertificates_certificateIdentifier,
    modifyCertificates_removeCustomerOverride,

    -- * Destructuring the Response
    ModifyCertificatesResponse (..),
    newModifyCertificatesResponse,

    -- * Response Lenses
    modifyCertificatesResponse_certificate,
    modifyCertificatesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifyCertificates' smart constructor.
data ModifyCertificates = ModifyCertificates'
  { -- | The new default certificate identifier to override the current one with.
    --
    -- To determine the valid values, use the @describe-certificates@ CLI
    -- command or the @DescribeCertificates@ API operation.
    ModifyCertificates -> Maybe Text
certificateIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether to remove the override for the default
    -- certificate. If the override is removed, the default certificate is the
    -- system default.
    ModifyCertificates -> Maybe Bool
removeCustomerOverride :: Prelude.Maybe Prelude.Bool
  }
  deriving (ModifyCertificates -> ModifyCertificates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyCertificates -> ModifyCertificates -> Bool
$c/= :: ModifyCertificates -> ModifyCertificates -> Bool
== :: ModifyCertificates -> ModifyCertificates -> Bool
$c== :: ModifyCertificates -> ModifyCertificates -> Bool
Prelude.Eq, ReadPrec [ModifyCertificates]
ReadPrec ModifyCertificates
Int -> ReadS ModifyCertificates
ReadS [ModifyCertificates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyCertificates]
$creadListPrec :: ReadPrec [ModifyCertificates]
readPrec :: ReadPrec ModifyCertificates
$creadPrec :: ReadPrec ModifyCertificates
readList :: ReadS [ModifyCertificates]
$creadList :: ReadS [ModifyCertificates]
readsPrec :: Int -> ReadS ModifyCertificates
$creadsPrec :: Int -> ReadS ModifyCertificates
Prelude.Read, Int -> ModifyCertificates -> ShowS
[ModifyCertificates] -> ShowS
ModifyCertificates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyCertificates] -> ShowS
$cshowList :: [ModifyCertificates] -> ShowS
show :: ModifyCertificates -> String
$cshow :: ModifyCertificates -> String
showsPrec :: Int -> ModifyCertificates -> ShowS
$cshowsPrec :: Int -> ModifyCertificates -> ShowS
Prelude.Show, forall x. Rep ModifyCertificates x -> ModifyCertificates
forall x. ModifyCertificates -> Rep ModifyCertificates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyCertificates x -> ModifyCertificates
$cfrom :: forall x. ModifyCertificates -> Rep ModifyCertificates x
Prelude.Generic)

-- |
-- Create a value of 'ModifyCertificates' 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:
--
-- 'certificateIdentifier', 'modifyCertificates_certificateIdentifier' - The new default certificate identifier to override the current one with.
--
-- To determine the valid values, use the @describe-certificates@ CLI
-- command or the @DescribeCertificates@ API operation.
--
-- 'removeCustomerOverride', 'modifyCertificates_removeCustomerOverride' - A value that indicates whether to remove the override for the default
-- certificate. If the override is removed, the default certificate is the
-- system default.
newModifyCertificates ::
  ModifyCertificates
newModifyCertificates :: ModifyCertificates
newModifyCertificates =
  ModifyCertificates'
    { $sel:certificateIdentifier:ModifyCertificates' :: Maybe Text
certificateIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:removeCustomerOverride:ModifyCertificates' :: Maybe Bool
removeCustomerOverride = forall a. Maybe a
Prelude.Nothing
    }

-- | The new default certificate identifier to override the current one with.
--
-- To determine the valid values, use the @describe-certificates@ CLI
-- command or the @DescribeCertificates@ API operation.
modifyCertificates_certificateIdentifier :: Lens.Lens' ModifyCertificates (Prelude.Maybe Prelude.Text)
modifyCertificates_certificateIdentifier :: Lens' ModifyCertificates (Maybe Text)
modifyCertificates_certificateIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCertificates' {Maybe Text
certificateIdentifier :: Maybe Text
$sel:certificateIdentifier:ModifyCertificates' :: ModifyCertificates -> Maybe Text
certificateIdentifier} -> Maybe Text
certificateIdentifier) (\s :: ModifyCertificates
s@ModifyCertificates' {} Maybe Text
a -> ModifyCertificates
s {$sel:certificateIdentifier:ModifyCertificates' :: Maybe Text
certificateIdentifier = Maybe Text
a} :: ModifyCertificates)

-- | A value that indicates whether to remove the override for the default
-- certificate. If the override is removed, the default certificate is the
-- system default.
modifyCertificates_removeCustomerOverride :: Lens.Lens' ModifyCertificates (Prelude.Maybe Prelude.Bool)
modifyCertificates_removeCustomerOverride :: Lens' ModifyCertificates (Maybe Bool)
modifyCertificates_removeCustomerOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCertificates' {Maybe Bool
removeCustomerOverride :: Maybe Bool
$sel:removeCustomerOverride:ModifyCertificates' :: ModifyCertificates -> Maybe Bool
removeCustomerOverride} -> Maybe Bool
removeCustomerOverride) (\s :: ModifyCertificates
s@ModifyCertificates' {} Maybe Bool
a -> ModifyCertificates
s {$sel:removeCustomerOverride:ModifyCertificates' :: Maybe Bool
removeCustomerOverride = Maybe Bool
a} :: ModifyCertificates)

instance Core.AWSRequest ModifyCertificates where
  type
    AWSResponse ModifyCertificates =
      ModifyCertificatesResponse
  request :: (Service -> Service)
-> ModifyCertificates -> Request ModifyCertificates
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 ModifyCertificates
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyCertificates)))
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
"ModifyCertificatesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Certificate -> Int -> ModifyCertificatesResponse
ModifyCertificatesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Certificate")
            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 ModifyCertificates where
  hashWithSalt :: Int -> ModifyCertificates -> Int
hashWithSalt Int
_salt ModifyCertificates' {Maybe Bool
Maybe Text
removeCustomerOverride :: Maybe Bool
certificateIdentifier :: Maybe Text
$sel:removeCustomerOverride:ModifyCertificates' :: ModifyCertificates -> Maybe Bool
$sel:certificateIdentifier:ModifyCertificates' :: ModifyCertificates -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificateIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
removeCustomerOverride

instance Prelude.NFData ModifyCertificates where
  rnf :: ModifyCertificates -> ()
rnf ModifyCertificates' {Maybe Bool
Maybe Text
removeCustomerOverride :: Maybe Bool
certificateIdentifier :: Maybe Text
$sel:removeCustomerOverride:ModifyCertificates' :: ModifyCertificates -> Maybe Bool
$sel:certificateIdentifier:ModifyCertificates' :: ModifyCertificates -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
removeCustomerOverride

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

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

instance Data.ToQuery ModifyCertificates where
  toQuery :: ModifyCertificates -> QueryString
toQuery ModifyCertificates' {Maybe Bool
Maybe Text
removeCustomerOverride :: Maybe Bool
certificateIdentifier :: Maybe Text
$sel:removeCustomerOverride:ModifyCertificates' :: ModifyCertificates -> Maybe Bool
$sel:certificateIdentifier:ModifyCertificates' :: ModifyCertificates -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyCertificates" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"CertificateIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
certificateIdentifier,
        ByteString
"RemoveCustomerOverride"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
removeCustomerOverride
      ]

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

-- |
-- Create a value of 'ModifyCertificatesResponse' 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:
--
-- 'certificate', 'modifyCertificatesResponse_certificate' - Undocumented member.
--
-- 'httpStatus', 'modifyCertificatesResponse_httpStatus' - The response's http status code.
newModifyCertificatesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyCertificatesResponse
newModifyCertificatesResponse :: Int -> ModifyCertificatesResponse
newModifyCertificatesResponse Int
pHttpStatus_ =
  ModifyCertificatesResponse'
    { $sel:certificate:ModifyCertificatesResponse' :: Maybe Certificate
certificate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyCertificatesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
modifyCertificatesResponse_certificate :: Lens.Lens' ModifyCertificatesResponse (Prelude.Maybe Certificate)
modifyCertificatesResponse_certificate :: Lens' ModifyCertificatesResponse (Maybe Certificate)
modifyCertificatesResponse_certificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCertificatesResponse' {Maybe Certificate
certificate :: Maybe Certificate
$sel:certificate:ModifyCertificatesResponse' :: ModifyCertificatesResponse -> Maybe Certificate
certificate} -> Maybe Certificate
certificate) (\s :: ModifyCertificatesResponse
s@ModifyCertificatesResponse' {} Maybe Certificate
a -> ModifyCertificatesResponse
s {$sel:certificate:ModifyCertificatesResponse' :: Maybe Certificate
certificate = Maybe Certificate
a} :: ModifyCertificatesResponse)

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

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