{-# 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.VoiceId.UpdateDomain
-- 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 specified domain. This API has clobber behavior, and clears
-- and replaces all attributes. If an optional field, such as
-- \'Description\' is not provided, it is removed from the domain.
module Amazonka.VoiceId.UpdateDomain
  ( -- * Creating a Request
    UpdateDomain (..),
    newUpdateDomain,

    -- * Request Lenses
    updateDomain_description,
    updateDomain_domainId,
    updateDomain_name,
    updateDomain_serverSideEncryptionConfiguration,

    -- * Destructuring the Response
    UpdateDomainResponse (..),
    newUpdateDomainResponse,

    -- * Response Lenses
    updateDomainResponse_domain,
    updateDomainResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.VoiceId.Types

-- | /See:/ 'newUpdateDomain' smart constructor.
data UpdateDomain = UpdateDomain'
  { -- | A brief description of the domain.
    UpdateDomain -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The identifier of the domain to be updated.
    UpdateDomain -> Text
domainId :: Prelude.Text,
    -- | The name of the domain.
    UpdateDomain -> Sensitive Text
name :: Data.Sensitive Prelude.Text,
    -- | The configuration, containing the KMS key identifier, to be used by
    -- Voice ID for the server-side encryption of your data. Changing the
    -- domain\'s associated KMS key immediately triggers an asynchronous
    -- process to remove dependency on the old KMS key, such that the domain\'s
    -- data can only be accessed using the new KMS key. The domain\'s
    -- @ServerSideEncryptionUpdateDetails@ contains the details for this
    -- process.
    UpdateDomain -> ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: ServerSideEncryptionConfiguration
  }
  deriving (UpdateDomain -> UpdateDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDomain -> UpdateDomain -> Bool
$c/= :: UpdateDomain -> UpdateDomain -> Bool
== :: UpdateDomain -> UpdateDomain -> Bool
$c== :: UpdateDomain -> UpdateDomain -> Bool
Prelude.Eq, Int -> UpdateDomain -> ShowS
[UpdateDomain] -> ShowS
UpdateDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDomain] -> ShowS
$cshowList :: [UpdateDomain] -> ShowS
show :: UpdateDomain -> String
$cshow :: UpdateDomain -> String
showsPrec :: Int -> UpdateDomain -> ShowS
$cshowsPrec :: Int -> UpdateDomain -> ShowS
Prelude.Show, forall x. Rep UpdateDomain x -> UpdateDomain
forall x. UpdateDomain -> Rep UpdateDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDomain x -> UpdateDomain
$cfrom :: forall x. UpdateDomain -> Rep UpdateDomain x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDomain' 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', 'updateDomain_description' - A brief description of the domain.
--
-- 'domainId', 'updateDomain_domainId' - The identifier of the domain to be updated.
--
-- 'name', 'updateDomain_name' - The name of the domain.
--
-- 'serverSideEncryptionConfiguration', 'updateDomain_serverSideEncryptionConfiguration' - The configuration, containing the KMS key identifier, to be used by
-- Voice ID for the server-side encryption of your data. Changing the
-- domain\'s associated KMS key immediately triggers an asynchronous
-- process to remove dependency on the old KMS key, such that the domain\'s
-- data can only be accessed using the new KMS key. The domain\'s
-- @ServerSideEncryptionUpdateDetails@ contains the details for this
-- process.
newUpdateDomain ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'serverSideEncryptionConfiguration'
  ServerSideEncryptionConfiguration ->
  UpdateDomain
newUpdateDomain :: Text -> Text -> ServerSideEncryptionConfiguration -> UpdateDomain
newUpdateDomain
  Text
pDomainId_
  Text
pName_
  ServerSideEncryptionConfiguration
pServerSideEncryptionConfiguration_ =
    UpdateDomain'
      { $sel:description:UpdateDomain' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:domainId:UpdateDomain' :: Text
domainId = Text
pDomainId_,
        $sel:name:UpdateDomain' :: Sensitive Text
name = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pName_,
        $sel:serverSideEncryptionConfiguration:UpdateDomain' :: ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration =
          ServerSideEncryptionConfiguration
pServerSideEncryptionConfiguration_
      }

-- | A brief description of the domain.
updateDomain_description :: Lens.Lens' UpdateDomain (Prelude.Maybe Prelude.Text)
updateDomain_description :: Lens' UpdateDomain (Maybe Text)
updateDomain_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:UpdateDomain' :: UpdateDomain -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe (Sensitive Text)
a -> UpdateDomain
s {$sel:description:UpdateDomain' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: UpdateDomain) 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 identifier of the domain to be updated.
updateDomain_domainId :: Lens.Lens' UpdateDomain Prelude.Text
updateDomain_domainId :: Lens' UpdateDomain Text
updateDomain_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Text
domainId :: Text
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
domainId} -> Text
domainId) (\s :: UpdateDomain
s@UpdateDomain' {} Text
a -> UpdateDomain
s {$sel:domainId:UpdateDomain' :: Text
domainId = Text
a} :: UpdateDomain)

-- | The name of the domain.
updateDomain_name :: Lens.Lens' UpdateDomain Prelude.Text
updateDomain_name :: Lens' UpdateDomain Text
updateDomain_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Sensitive Text
name :: Sensitive Text
$sel:name:UpdateDomain' :: UpdateDomain -> Sensitive Text
name} -> Sensitive Text
name) (\s :: UpdateDomain
s@UpdateDomain' {} Sensitive Text
a -> UpdateDomain
s {$sel:name:UpdateDomain' :: Sensitive Text
name = Sensitive Text
a} :: UpdateDomain) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The configuration, containing the KMS key identifier, to be used by
-- Voice ID for the server-side encryption of your data. Changing the
-- domain\'s associated KMS key immediately triggers an asynchronous
-- process to remove dependency on the old KMS key, such that the domain\'s
-- data can only be accessed using the new KMS key. The domain\'s
-- @ServerSideEncryptionUpdateDetails@ contains the details for this
-- process.
updateDomain_serverSideEncryptionConfiguration :: Lens.Lens' UpdateDomain ServerSideEncryptionConfiguration
updateDomain_serverSideEncryptionConfiguration :: Lens' UpdateDomain ServerSideEncryptionConfiguration
updateDomain_serverSideEncryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: ServerSideEncryptionConfiguration
$sel:serverSideEncryptionConfiguration:UpdateDomain' :: UpdateDomain -> ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration} -> ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration) (\s :: UpdateDomain
s@UpdateDomain' {} ServerSideEncryptionConfiguration
a -> UpdateDomain
s {$sel:serverSideEncryptionConfiguration:UpdateDomain' :: ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration = ServerSideEncryptionConfiguration
a} :: UpdateDomain)

instance Core.AWSRequest UpdateDomain where
  type AWSResponse UpdateDomain = UpdateDomainResponse
  request :: (Service -> Service) -> UpdateDomain -> Request UpdateDomain
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 UpdateDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDomain)))
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 Domain -> Int -> UpdateDomainResponse
UpdateDomainResponse'
            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
"Domain")
            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 UpdateDomain where
  hashWithSalt :: Int -> UpdateDomain -> Int
hashWithSalt Int
_salt UpdateDomain' {Maybe (Sensitive Text)
Text
Sensitive Text
ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: ServerSideEncryptionConfiguration
name :: Sensitive Text
domainId :: Text
description :: Maybe (Sensitive Text)
$sel:serverSideEncryptionConfiguration:UpdateDomain' :: UpdateDomain -> ServerSideEncryptionConfiguration
$sel:name:UpdateDomain' :: UpdateDomain -> Sensitive Text
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
$sel:description:UpdateDomain' :: UpdateDomain -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration

instance Prelude.NFData UpdateDomain where
  rnf :: UpdateDomain -> ()
rnf UpdateDomain' {Maybe (Sensitive Text)
Text
Sensitive Text
ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: ServerSideEncryptionConfiguration
name :: Sensitive Text
domainId :: Text
description :: Maybe (Sensitive Text)
$sel:serverSideEncryptionConfiguration:UpdateDomain' :: UpdateDomain -> ServerSideEncryptionConfiguration
$sel:name:UpdateDomain' :: UpdateDomain -> Sensitive Text
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
$sel:description:UpdateDomain' :: UpdateDomain -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration

instance Data.ToHeaders UpdateDomain where
  toHeaders :: UpdateDomain -> 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
"VoiceID.UpdateDomain" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateDomain where
  toJSON :: UpdateDomain -> Value
toJSON UpdateDomain' {Maybe (Sensitive Text)
Text
Sensitive Text
ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: ServerSideEncryptionConfiguration
name :: Sensitive Text
domainId :: Text
description :: Maybe (Sensitive Text)
$sel:serverSideEncryptionConfiguration:UpdateDomain' :: UpdateDomain -> ServerSideEncryptionConfiguration
$sel:name:UpdateDomain' :: UpdateDomain -> Sensitive Text
$sel:domainId:UpdateDomain' :: UpdateDomain -> Text
$sel:description:UpdateDomain' :: UpdateDomain -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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)
description,
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
name),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ServerSideEncryptionConfiguration"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration
              )
          ]
      )

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

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

-- | /See:/ 'newUpdateDomainResponse' smart constructor.
data UpdateDomainResponse = UpdateDomainResponse'
  { -- | Details about the updated domain
    UpdateDomainResponse -> Maybe Domain
domain :: Prelude.Maybe Domain,
    -- | The response's http status code.
    UpdateDomainResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDomainResponse -> UpdateDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
$c/= :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
== :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
$c== :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
Prelude.Eq, Int -> UpdateDomainResponse -> ShowS
[UpdateDomainResponse] -> ShowS
UpdateDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDomainResponse] -> ShowS
$cshowList :: [UpdateDomainResponse] -> ShowS
show :: UpdateDomainResponse -> String
$cshow :: UpdateDomainResponse -> String
showsPrec :: Int -> UpdateDomainResponse -> ShowS
$cshowsPrec :: Int -> UpdateDomainResponse -> ShowS
Prelude.Show, forall x. Rep UpdateDomainResponse x -> UpdateDomainResponse
forall x. UpdateDomainResponse -> Rep UpdateDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDomainResponse x -> UpdateDomainResponse
$cfrom :: forall x. UpdateDomainResponse -> Rep UpdateDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDomainResponse' 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:
--
-- 'domain', 'updateDomainResponse_domain' - Details about the updated domain
--
-- 'httpStatus', 'updateDomainResponse_httpStatus' - The response's http status code.
newUpdateDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDomainResponse
newUpdateDomainResponse :: Int -> UpdateDomainResponse
newUpdateDomainResponse Int
pHttpStatus_ =
  UpdateDomainResponse'
    { $sel:domain:UpdateDomainResponse' :: Maybe Domain
domain = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDomainResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details about the updated domain
updateDomainResponse_domain :: Lens.Lens' UpdateDomainResponse (Prelude.Maybe Domain)
updateDomainResponse_domain :: Lens' UpdateDomainResponse (Maybe Domain)
updateDomainResponse_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainResponse' {Maybe Domain
domain :: Maybe Domain
$sel:domain:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe Domain
domain} -> Maybe Domain
domain) (\s :: UpdateDomainResponse
s@UpdateDomainResponse' {} Maybe Domain
a -> UpdateDomainResponse
s {$sel:domain:UpdateDomainResponse' :: Maybe Domain
domain = Maybe Domain
a} :: UpdateDomainResponse)

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

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