{-# 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.Backup.UpdateRegionSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the current service opt-in settings for the Region. If
-- service-opt-in is enabled for a service, Backup tries to protect that
-- service\'s resources in this Region, when the resource is included in an
-- on-demand backup or scheduled backup plan. Otherwise, Backup does not
-- try to protect that service\'s resources in this Region. Use the
-- @DescribeRegionSettings@ API to determine the resource types that are
-- supported.
module Amazonka.Backup.UpdateRegionSettings
  ( -- * Creating a Request
    UpdateRegionSettings (..),
    newUpdateRegionSettings,

    -- * Request Lenses
    updateRegionSettings_resourceTypeManagementPreference,
    updateRegionSettings_resourceTypeOptInPreference,

    -- * Destructuring the Response
    UpdateRegionSettingsResponse (..),
    newUpdateRegionSettingsResponse,
  )
where

import Amazonka.Backup.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateRegionSettings' smart constructor.
data UpdateRegionSettings = UpdateRegionSettings'
  { -- | Enables or disables full Backup management of backups for a resource
    -- type. To enable full Backup management for DynamoDB along with
    -- <https://docs.aws.amazon.com/aws-backup/latest/devguide/advanced-ddb-backup.html Backup\'s advanced DynamoDB backup features>,
    -- follow the procedure to
    -- <https://docs.aws.amazon.com/aws-backup/latest/devguide/advanced-ddb-backup.html#advanced-ddb-backup-enable-cli enable advanced DynamoDB backup programmatically>.
    UpdateRegionSettings -> Maybe (HashMap Text Bool)
resourceTypeManagementPreference :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Bool),
    -- | Updates the list of services along with the opt-in preferences for the
    -- Region.
    UpdateRegionSettings -> Maybe (HashMap Text Bool)
resourceTypeOptInPreference :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Bool)
  }
  deriving (UpdateRegionSettings -> UpdateRegionSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRegionSettings -> UpdateRegionSettings -> Bool
$c/= :: UpdateRegionSettings -> UpdateRegionSettings -> Bool
== :: UpdateRegionSettings -> UpdateRegionSettings -> Bool
$c== :: UpdateRegionSettings -> UpdateRegionSettings -> Bool
Prelude.Eq, ReadPrec [UpdateRegionSettings]
ReadPrec UpdateRegionSettings
Int -> ReadS UpdateRegionSettings
ReadS [UpdateRegionSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRegionSettings]
$creadListPrec :: ReadPrec [UpdateRegionSettings]
readPrec :: ReadPrec UpdateRegionSettings
$creadPrec :: ReadPrec UpdateRegionSettings
readList :: ReadS [UpdateRegionSettings]
$creadList :: ReadS [UpdateRegionSettings]
readsPrec :: Int -> ReadS UpdateRegionSettings
$creadsPrec :: Int -> ReadS UpdateRegionSettings
Prelude.Read, Int -> UpdateRegionSettings -> ShowS
[UpdateRegionSettings] -> ShowS
UpdateRegionSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRegionSettings] -> ShowS
$cshowList :: [UpdateRegionSettings] -> ShowS
show :: UpdateRegionSettings -> String
$cshow :: UpdateRegionSettings -> String
showsPrec :: Int -> UpdateRegionSettings -> ShowS
$cshowsPrec :: Int -> UpdateRegionSettings -> ShowS
Prelude.Show, forall x. Rep UpdateRegionSettings x -> UpdateRegionSettings
forall x. UpdateRegionSettings -> Rep UpdateRegionSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRegionSettings x -> UpdateRegionSettings
$cfrom :: forall x. UpdateRegionSettings -> Rep UpdateRegionSettings x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRegionSettings' 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:
--
-- 'resourceTypeManagementPreference', 'updateRegionSettings_resourceTypeManagementPreference' - Enables or disables full Backup management of backups for a resource
-- type. To enable full Backup management for DynamoDB along with
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/advanced-ddb-backup.html Backup\'s advanced DynamoDB backup features>,
-- follow the procedure to
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/advanced-ddb-backup.html#advanced-ddb-backup-enable-cli enable advanced DynamoDB backup programmatically>.
--
-- 'resourceTypeOptInPreference', 'updateRegionSettings_resourceTypeOptInPreference' - Updates the list of services along with the opt-in preferences for the
-- Region.
newUpdateRegionSettings ::
  UpdateRegionSettings
newUpdateRegionSettings :: UpdateRegionSettings
newUpdateRegionSettings =
  UpdateRegionSettings'
    { $sel:resourceTypeManagementPreference:UpdateRegionSettings' :: Maybe (HashMap Text Bool)
resourceTypeManagementPreference =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resourceTypeOptInPreference:UpdateRegionSettings' :: Maybe (HashMap Text Bool)
resourceTypeOptInPreference = forall a. Maybe a
Prelude.Nothing
    }

-- | Enables or disables full Backup management of backups for a resource
-- type. To enable full Backup management for DynamoDB along with
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/advanced-ddb-backup.html Backup\'s advanced DynamoDB backup features>,
-- follow the procedure to
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/advanced-ddb-backup.html#advanced-ddb-backup-enable-cli enable advanced DynamoDB backup programmatically>.
updateRegionSettings_resourceTypeManagementPreference :: Lens.Lens' UpdateRegionSettings (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Bool))
updateRegionSettings_resourceTypeManagementPreference :: Lens' UpdateRegionSettings (Maybe (HashMap Text Bool))
updateRegionSettings_resourceTypeManagementPreference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRegionSettings' {Maybe (HashMap Text Bool)
resourceTypeManagementPreference :: Maybe (HashMap Text Bool)
$sel:resourceTypeManagementPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
resourceTypeManagementPreference} -> Maybe (HashMap Text Bool)
resourceTypeManagementPreference) (\s :: UpdateRegionSettings
s@UpdateRegionSettings' {} Maybe (HashMap Text Bool)
a -> UpdateRegionSettings
s {$sel:resourceTypeManagementPreference:UpdateRegionSettings' :: Maybe (HashMap Text Bool)
resourceTypeManagementPreference = Maybe (HashMap Text Bool)
a} :: UpdateRegionSettings) 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

-- | Updates the list of services along with the opt-in preferences for the
-- Region.
updateRegionSettings_resourceTypeOptInPreference :: Lens.Lens' UpdateRegionSettings (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Bool))
updateRegionSettings_resourceTypeOptInPreference :: Lens' UpdateRegionSettings (Maybe (HashMap Text Bool))
updateRegionSettings_resourceTypeOptInPreference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRegionSettings' {Maybe (HashMap Text Bool)
resourceTypeOptInPreference :: Maybe (HashMap Text Bool)
$sel:resourceTypeOptInPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
resourceTypeOptInPreference} -> Maybe (HashMap Text Bool)
resourceTypeOptInPreference) (\s :: UpdateRegionSettings
s@UpdateRegionSettings' {} Maybe (HashMap Text Bool)
a -> UpdateRegionSettings
s {$sel:resourceTypeOptInPreference:UpdateRegionSettings' :: Maybe (HashMap Text Bool)
resourceTypeOptInPreference = Maybe (HashMap Text Bool)
a} :: UpdateRegionSettings) 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

instance Core.AWSRequest UpdateRegionSettings where
  type
    AWSResponse UpdateRegionSettings =
      UpdateRegionSettingsResponse
  request :: (Service -> Service)
-> UpdateRegionSettings -> Request UpdateRegionSettings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateRegionSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateRegionSettings)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateRegionSettingsResponse
UpdateRegionSettingsResponse'

instance Prelude.Hashable UpdateRegionSettings where
  hashWithSalt :: Int -> UpdateRegionSettings -> Int
hashWithSalt Int
_salt UpdateRegionSettings' {Maybe (HashMap Text Bool)
resourceTypeOptInPreference :: Maybe (HashMap Text Bool)
resourceTypeManagementPreference :: Maybe (HashMap Text Bool)
$sel:resourceTypeOptInPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
$sel:resourceTypeManagementPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Bool)
resourceTypeManagementPreference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Bool)
resourceTypeOptInPreference

instance Prelude.NFData UpdateRegionSettings where
  rnf :: UpdateRegionSettings -> ()
rnf UpdateRegionSettings' {Maybe (HashMap Text Bool)
resourceTypeOptInPreference :: Maybe (HashMap Text Bool)
resourceTypeManagementPreference :: Maybe (HashMap Text Bool)
$sel:resourceTypeOptInPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
$sel:resourceTypeManagementPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Bool)
resourceTypeManagementPreference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Bool)
resourceTypeOptInPreference

instance Data.ToHeaders UpdateRegionSettings where
  toHeaders :: UpdateRegionSettings -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateRegionSettings where
  toJSON :: UpdateRegionSettings -> Value
toJSON UpdateRegionSettings' {Maybe (HashMap Text Bool)
resourceTypeOptInPreference :: Maybe (HashMap Text Bool)
resourceTypeManagementPreference :: Maybe (HashMap Text Bool)
$sel:resourceTypeOptInPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
$sel:resourceTypeManagementPreference:UpdateRegionSettings' :: UpdateRegionSettings -> Maybe (HashMap Text Bool)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ResourceTypeManagementPreference" 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 (HashMap Text Bool)
resourceTypeManagementPreference,
            (Key
"ResourceTypeOptInPreference" 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 (HashMap Text Bool)
resourceTypeOptInPreference
          ]
      )

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

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

-- | /See:/ 'newUpdateRegionSettingsResponse' smart constructor.
data UpdateRegionSettingsResponse = UpdateRegionSettingsResponse'
  {
  }
  deriving (UpdateRegionSettingsResponse
-> UpdateRegionSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRegionSettingsResponse
-> UpdateRegionSettingsResponse -> Bool
$c/= :: UpdateRegionSettingsResponse
-> UpdateRegionSettingsResponse -> Bool
== :: UpdateRegionSettingsResponse
-> UpdateRegionSettingsResponse -> Bool
$c== :: UpdateRegionSettingsResponse
-> UpdateRegionSettingsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateRegionSettingsResponse]
ReadPrec UpdateRegionSettingsResponse
Int -> ReadS UpdateRegionSettingsResponse
ReadS [UpdateRegionSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRegionSettingsResponse]
$creadListPrec :: ReadPrec [UpdateRegionSettingsResponse]
readPrec :: ReadPrec UpdateRegionSettingsResponse
$creadPrec :: ReadPrec UpdateRegionSettingsResponse
readList :: ReadS [UpdateRegionSettingsResponse]
$creadList :: ReadS [UpdateRegionSettingsResponse]
readsPrec :: Int -> ReadS UpdateRegionSettingsResponse
$creadsPrec :: Int -> ReadS UpdateRegionSettingsResponse
Prelude.Read, Int -> UpdateRegionSettingsResponse -> ShowS
[UpdateRegionSettingsResponse] -> ShowS
UpdateRegionSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRegionSettingsResponse] -> ShowS
$cshowList :: [UpdateRegionSettingsResponse] -> ShowS
show :: UpdateRegionSettingsResponse -> String
$cshow :: UpdateRegionSettingsResponse -> String
showsPrec :: Int -> UpdateRegionSettingsResponse -> ShowS
$cshowsPrec :: Int -> UpdateRegionSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateRegionSettingsResponse x -> UpdateRegionSettingsResponse
forall x.
UpdateRegionSettingsResponse -> Rep UpdateRegionSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRegionSettingsResponse x -> UpdateRegionSettingsResponse
$cfrom :: forall x.
UpdateRegionSettingsResponse -> Rep UpdateRegionSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRegionSettingsResponse' 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.
newUpdateRegionSettingsResponse ::
  UpdateRegionSettingsResponse
newUpdateRegionSettingsResponse :: UpdateRegionSettingsResponse
newUpdateRegionSettingsResponse =
  UpdateRegionSettingsResponse
UpdateRegionSettingsResponse'

instance Prelude.NFData UpdateRegionSettingsResponse where
  rnf :: UpdateRegionSettingsResponse -> ()
rnf UpdateRegionSettingsResponse
_ = ()