{-# 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.LexV2Models.UpdateBotLocale
-- 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 settings that a bot has for a specific locale.
module Amazonka.LexV2Models.UpdateBotLocale
  ( -- * Creating a Request
    UpdateBotLocale (..),
    newUpdateBotLocale,

    -- * Request Lenses
    updateBotLocale_description,
    updateBotLocale_voiceSettings,
    updateBotLocale_botId,
    updateBotLocale_botVersion,
    updateBotLocale_localeId,
    updateBotLocale_nluIntentConfidenceThreshold,

    -- * Destructuring the Response
    UpdateBotLocaleResponse (..),
    newUpdateBotLocaleResponse,

    -- * Response Lenses
    updateBotLocaleResponse_botId,
    updateBotLocaleResponse_botLocaleStatus,
    updateBotLocaleResponse_botVersion,
    updateBotLocaleResponse_creationDateTime,
    updateBotLocaleResponse_description,
    updateBotLocaleResponse_failureReasons,
    updateBotLocaleResponse_lastUpdatedDateTime,
    updateBotLocaleResponse_localeId,
    updateBotLocaleResponse_localeName,
    updateBotLocaleResponse_nluIntentConfidenceThreshold,
    updateBotLocaleResponse_recommendedActions,
    updateBotLocaleResponse_voiceSettings,
    updateBotLocaleResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateBotLocale' smart constructor.
data UpdateBotLocale = UpdateBotLocale'
  { -- | The new description of the locale.
    UpdateBotLocale -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The new Amazon Polly voice Amazon Lex should use for voice interaction
    -- with the user.
    UpdateBotLocale -> Maybe VoiceSettings
voiceSettings :: Prelude.Maybe VoiceSettings,
    -- | The unique identifier of the bot that contains the locale.
    UpdateBotLocale -> Text
botId :: Prelude.Text,
    -- | The version of the bot that contains the locale to be updated. The
    -- version can only be the @DRAFT@ version.
    UpdateBotLocale -> Text
botVersion :: Prelude.Text,
    -- | The identifier of the language and locale to update. The string must
    -- match one of the supported locales. For more information, see
    -- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
    UpdateBotLocale -> Text
localeId :: Prelude.Text,
    -- | The new confidence threshold where Amazon Lex inserts the
    -- @AMAZON.FallbackIntent@ and @AMAZON.KendraSearchIntent@ intents in the
    -- list of possible intents for an utterance.
    UpdateBotLocale -> Double
nluIntentConfidenceThreshold :: Prelude.Double
  }
  deriving (UpdateBotLocale -> UpdateBotLocale -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBotLocale -> UpdateBotLocale -> Bool
$c/= :: UpdateBotLocale -> UpdateBotLocale -> Bool
== :: UpdateBotLocale -> UpdateBotLocale -> Bool
$c== :: UpdateBotLocale -> UpdateBotLocale -> Bool
Prelude.Eq, ReadPrec [UpdateBotLocale]
ReadPrec UpdateBotLocale
Int -> ReadS UpdateBotLocale
ReadS [UpdateBotLocale]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBotLocale]
$creadListPrec :: ReadPrec [UpdateBotLocale]
readPrec :: ReadPrec UpdateBotLocale
$creadPrec :: ReadPrec UpdateBotLocale
readList :: ReadS [UpdateBotLocale]
$creadList :: ReadS [UpdateBotLocale]
readsPrec :: Int -> ReadS UpdateBotLocale
$creadsPrec :: Int -> ReadS UpdateBotLocale
Prelude.Read, Int -> UpdateBotLocale -> ShowS
[UpdateBotLocale] -> ShowS
UpdateBotLocale -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBotLocale] -> ShowS
$cshowList :: [UpdateBotLocale] -> ShowS
show :: UpdateBotLocale -> String
$cshow :: UpdateBotLocale -> String
showsPrec :: Int -> UpdateBotLocale -> ShowS
$cshowsPrec :: Int -> UpdateBotLocale -> ShowS
Prelude.Show, forall x. Rep UpdateBotLocale x -> UpdateBotLocale
forall x. UpdateBotLocale -> Rep UpdateBotLocale x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBotLocale x -> UpdateBotLocale
$cfrom :: forall x. UpdateBotLocale -> Rep UpdateBotLocale x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBotLocale' 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', 'updateBotLocale_description' - The new description of the locale.
--
-- 'voiceSettings', 'updateBotLocale_voiceSettings' - The new Amazon Polly voice Amazon Lex should use for voice interaction
-- with the user.
--
-- 'botId', 'updateBotLocale_botId' - The unique identifier of the bot that contains the locale.
--
-- 'botVersion', 'updateBotLocale_botVersion' - The version of the bot that contains the locale to be updated. The
-- version can only be the @DRAFT@ version.
--
-- 'localeId', 'updateBotLocale_localeId' - The identifier of the language and locale to update. The string must
-- match one of the supported locales. For more information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
--
-- 'nluIntentConfidenceThreshold', 'updateBotLocale_nluIntentConfidenceThreshold' - The new confidence threshold where Amazon Lex inserts the
-- @AMAZON.FallbackIntent@ and @AMAZON.KendraSearchIntent@ intents in the
-- list of possible intents for an utterance.
newUpdateBotLocale ::
  -- | 'botId'
  Prelude.Text ->
  -- | 'botVersion'
  Prelude.Text ->
  -- | 'localeId'
  Prelude.Text ->
  -- | 'nluIntentConfidenceThreshold'
  Prelude.Double ->
  UpdateBotLocale
newUpdateBotLocale :: Text -> Text -> Text -> Double -> UpdateBotLocale
newUpdateBotLocale
  Text
pBotId_
  Text
pBotVersion_
  Text
pLocaleId_
  Double
pNluIntentConfidenceThreshold_ =
    UpdateBotLocale'
      { $sel:description:UpdateBotLocale' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:voiceSettings:UpdateBotLocale' :: Maybe VoiceSettings
voiceSettings = forall a. Maybe a
Prelude.Nothing,
        $sel:botId:UpdateBotLocale' :: Text
botId = Text
pBotId_,
        $sel:botVersion:UpdateBotLocale' :: Text
botVersion = Text
pBotVersion_,
        $sel:localeId:UpdateBotLocale' :: Text
localeId = Text
pLocaleId_,
        $sel:nluIntentConfidenceThreshold:UpdateBotLocale' :: Double
nluIntentConfidenceThreshold =
          Double
pNluIntentConfidenceThreshold_
      }

-- | The new description of the locale.
updateBotLocale_description :: Lens.Lens' UpdateBotLocale (Prelude.Maybe Prelude.Text)
updateBotLocale_description :: Lens' UpdateBotLocale (Maybe Text)
updateBotLocale_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocale' {Maybe Text
description :: Maybe Text
$sel:description:UpdateBotLocale' :: UpdateBotLocale -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateBotLocale
s@UpdateBotLocale' {} Maybe Text
a -> UpdateBotLocale
s {$sel:description:UpdateBotLocale' :: Maybe Text
description = Maybe Text
a} :: UpdateBotLocale)

-- | The new Amazon Polly voice Amazon Lex should use for voice interaction
-- with the user.
updateBotLocale_voiceSettings :: Lens.Lens' UpdateBotLocale (Prelude.Maybe VoiceSettings)
updateBotLocale_voiceSettings :: Lens' UpdateBotLocale (Maybe VoiceSettings)
updateBotLocale_voiceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocale' {Maybe VoiceSettings
voiceSettings :: Maybe VoiceSettings
$sel:voiceSettings:UpdateBotLocale' :: UpdateBotLocale -> Maybe VoiceSettings
voiceSettings} -> Maybe VoiceSettings
voiceSettings) (\s :: UpdateBotLocale
s@UpdateBotLocale' {} Maybe VoiceSettings
a -> UpdateBotLocale
s {$sel:voiceSettings:UpdateBotLocale' :: Maybe VoiceSettings
voiceSettings = Maybe VoiceSettings
a} :: UpdateBotLocale)

-- | The unique identifier of the bot that contains the locale.
updateBotLocale_botId :: Lens.Lens' UpdateBotLocale Prelude.Text
updateBotLocale_botId :: Lens' UpdateBotLocale Text
updateBotLocale_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocale' {Text
botId :: Text
$sel:botId:UpdateBotLocale' :: UpdateBotLocale -> Text
botId} -> Text
botId) (\s :: UpdateBotLocale
s@UpdateBotLocale' {} Text
a -> UpdateBotLocale
s {$sel:botId:UpdateBotLocale' :: Text
botId = Text
a} :: UpdateBotLocale)

-- | The version of the bot that contains the locale to be updated. The
-- version can only be the @DRAFT@ version.
updateBotLocale_botVersion :: Lens.Lens' UpdateBotLocale Prelude.Text
updateBotLocale_botVersion :: Lens' UpdateBotLocale Text
updateBotLocale_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocale' {Text
botVersion :: Text
$sel:botVersion:UpdateBotLocale' :: UpdateBotLocale -> Text
botVersion} -> Text
botVersion) (\s :: UpdateBotLocale
s@UpdateBotLocale' {} Text
a -> UpdateBotLocale
s {$sel:botVersion:UpdateBotLocale' :: Text
botVersion = Text
a} :: UpdateBotLocale)

-- | The identifier of the language and locale to update. The string must
-- match one of the supported locales. For more information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
updateBotLocale_localeId :: Lens.Lens' UpdateBotLocale Prelude.Text
updateBotLocale_localeId :: Lens' UpdateBotLocale Text
updateBotLocale_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocale' {Text
localeId :: Text
$sel:localeId:UpdateBotLocale' :: UpdateBotLocale -> Text
localeId} -> Text
localeId) (\s :: UpdateBotLocale
s@UpdateBotLocale' {} Text
a -> UpdateBotLocale
s {$sel:localeId:UpdateBotLocale' :: Text
localeId = Text
a} :: UpdateBotLocale)

-- | The new confidence threshold where Amazon Lex inserts the
-- @AMAZON.FallbackIntent@ and @AMAZON.KendraSearchIntent@ intents in the
-- list of possible intents for an utterance.
updateBotLocale_nluIntentConfidenceThreshold :: Lens.Lens' UpdateBotLocale Prelude.Double
updateBotLocale_nluIntentConfidenceThreshold :: Lens' UpdateBotLocale Double
updateBotLocale_nluIntentConfidenceThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocale' {Double
nluIntentConfidenceThreshold :: Double
$sel:nluIntentConfidenceThreshold:UpdateBotLocale' :: UpdateBotLocale -> Double
nluIntentConfidenceThreshold} -> Double
nluIntentConfidenceThreshold) (\s :: UpdateBotLocale
s@UpdateBotLocale' {} Double
a -> UpdateBotLocale
s {$sel:nluIntentConfidenceThreshold:UpdateBotLocale' :: Double
nluIntentConfidenceThreshold = Double
a} :: UpdateBotLocale)

instance Core.AWSRequest UpdateBotLocale where
  type
    AWSResponse UpdateBotLocale =
      UpdateBotLocaleResponse
  request :: (Service -> Service) -> UpdateBotLocale -> Request UpdateBotLocale
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 UpdateBotLocale
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateBotLocale)))
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 Text
-> Maybe BotLocaleStatus
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe [Text]
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Double
-> Maybe [Text]
-> Maybe VoiceSettings
-> Int
-> UpdateBotLocaleResponse
UpdateBotLocaleResponse'
            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
"botId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"botLocaleStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"botVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"creationDateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"failureReasons" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"lastUpdatedDateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"localeId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"localeName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"nluIntentConfidenceThreshold")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"recommendedActions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"voiceSettings")
            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 UpdateBotLocale where
  hashWithSalt :: Int -> UpdateBotLocale -> Int
hashWithSalt Int
_salt UpdateBotLocale' {Double
Maybe Text
Maybe VoiceSettings
Text
nluIntentConfidenceThreshold :: Double
localeId :: Text
botVersion :: Text
botId :: Text
voiceSettings :: Maybe VoiceSettings
description :: Maybe Text
$sel:nluIntentConfidenceThreshold:UpdateBotLocale' :: UpdateBotLocale -> Double
$sel:localeId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botVersion:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:voiceSettings:UpdateBotLocale' :: UpdateBotLocale -> Maybe VoiceSettings
$sel:description:UpdateBotLocale' :: UpdateBotLocale -> 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 VoiceSettings
voiceSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
localeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Double
nluIntentConfidenceThreshold

instance Prelude.NFData UpdateBotLocale where
  rnf :: UpdateBotLocale -> ()
rnf UpdateBotLocale' {Double
Maybe Text
Maybe VoiceSettings
Text
nluIntentConfidenceThreshold :: Double
localeId :: Text
botVersion :: Text
botId :: Text
voiceSettings :: Maybe VoiceSettings
description :: Maybe Text
$sel:nluIntentConfidenceThreshold:UpdateBotLocale' :: UpdateBotLocale -> Double
$sel:localeId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botVersion:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:voiceSettings:UpdateBotLocale' :: UpdateBotLocale -> Maybe VoiceSettings
$sel:description:UpdateBotLocale' :: UpdateBotLocale -> 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 VoiceSettings
voiceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
localeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Double
nluIntentConfidenceThreshold

instance Data.ToHeaders UpdateBotLocale where
  toHeaders :: UpdateBotLocale -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateBotLocale where
  toJSON :: UpdateBotLocale -> Value
toJSON UpdateBotLocale' {Double
Maybe Text
Maybe VoiceSettings
Text
nluIntentConfidenceThreshold :: Double
localeId :: Text
botVersion :: Text
botId :: Text
voiceSettings :: Maybe VoiceSettings
description :: Maybe Text
$sel:nluIntentConfidenceThreshold:UpdateBotLocale' :: UpdateBotLocale -> Double
$sel:localeId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botVersion:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:voiceSettings:UpdateBotLocale' :: UpdateBotLocale -> Maybe VoiceSettings
$sel:description:UpdateBotLocale' :: UpdateBotLocale -> Maybe 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 Text
description,
            (Key
"voiceSettings" 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 VoiceSettings
voiceSettings,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"nluIntentConfidenceThreshold"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Double
nluIntentConfidenceThreshold
              )
          ]
      )

instance Data.ToPath UpdateBotLocale where
  toPath :: UpdateBotLocale -> ByteString
toPath UpdateBotLocale' {Double
Maybe Text
Maybe VoiceSettings
Text
nluIntentConfidenceThreshold :: Double
localeId :: Text
botVersion :: Text
botId :: Text
voiceSettings :: Maybe VoiceSettings
description :: Maybe Text
$sel:nluIntentConfidenceThreshold:UpdateBotLocale' :: UpdateBotLocale -> Double
$sel:localeId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botVersion:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:botId:UpdateBotLocale' :: UpdateBotLocale -> Text
$sel:voiceSettings:UpdateBotLocale' :: UpdateBotLocale -> Maybe VoiceSettings
$sel:description:UpdateBotLocale' :: UpdateBotLocale -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botId,
        ByteString
"/botversions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botVersion,
        ByteString
"/botlocales/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
localeId,
        ByteString
"/"
      ]

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

-- | /See:/ 'newUpdateBotLocaleResponse' smart constructor.
data UpdateBotLocaleResponse = UpdateBotLocaleResponse'
  { -- | The identifier of the bot that contains the updated locale.
    UpdateBotLocaleResponse -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | The current status of the locale. When the bot status is @Built@ the
    -- locale is ready for use.
    UpdateBotLocaleResponse -> Maybe BotLocaleStatus
botLocaleStatus :: Prelude.Maybe BotLocaleStatus,
    -- | The version of the bot that contains the updated locale.
    UpdateBotLocaleResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | A timestamp of the date and time that the locale was created.
    UpdateBotLocaleResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The updated description of the locale.
    UpdateBotLocaleResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | If the @botLocaleStatus@ is @Failed@, the @failureReasons@ field lists
    -- the errors that occurred while building the bot.
    UpdateBotLocaleResponse -> Maybe [Text]
failureReasons :: Prelude.Maybe [Prelude.Text],
    -- | A timestamp of the date and time that the locale was last updated.
    UpdateBotLocaleResponse -> Maybe POSIX
lastUpdatedDateTime :: Prelude.Maybe Data.POSIX,
    -- | The language and locale of the updated bot locale.
    UpdateBotLocaleResponse -> Maybe Text
localeId :: Prelude.Maybe Prelude.Text,
    -- | The updated locale name for the locale.
    UpdateBotLocaleResponse -> Maybe Text
localeName :: Prelude.Maybe Prelude.Text,
    -- | The updated confidence threshold for inserting the
    -- @AMAZON.FallbackIntent@ and @AMAZON.KendraSearchIntent@ intents in the
    -- list of possible intents for an utterance.
    UpdateBotLocaleResponse -> Maybe Double
nluIntentConfidenceThreshold :: Prelude.Maybe Prelude.Double,
    -- | Recommended actions to take to resolve an error in the @failureReasons@
    -- field.
    UpdateBotLocaleResponse -> Maybe [Text]
recommendedActions :: Prelude.Maybe [Prelude.Text],
    -- | The updated Amazon Polly voice to use for voice interaction with the
    -- user.
    UpdateBotLocaleResponse -> Maybe VoiceSettings
voiceSettings :: Prelude.Maybe VoiceSettings,
    -- | The response's http status code.
    UpdateBotLocaleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateBotLocaleResponse -> UpdateBotLocaleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBotLocaleResponse -> UpdateBotLocaleResponse -> Bool
$c/= :: UpdateBotLocaleResponse -> UpdateBotLocaleResponse -> Bool
== :: UpdateBotLocaleResponse -> UpdateBotLocaleResponse -> Bool
$c== :: UpdateBotLocaleResponse -> UpdateBotLocaleResponse -> Bool
Prelude.Eq, ReadPrec [UpdateBotLocaleResponse]
ReadPrec UpdateBotLocaleResponse
Int -> ReadS UpdateBotLocaleResponse
ReadS [UpdateBotLocaleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBotLocaleResponse]
$creadListPrec :: ReadPrec [UpdateBotLocaleResponse]
readPrec :: ReadPrec UpdateBotLocaleResponse
$creadPrec :: ReadPrec UpdateBotLocaleResponse
readList :: ReadS [UpdateBotLocaleResponse]
$creadList :: ReadS [UpdateBotLocaleResponse]
readsPrec :: Int -> ReadS UpdateBotLocaleResponse
$creadsPrec :: Int -> ReadS UpdateBotLocaleResponse
Prelude.Read, Int -> UpdateBotLocaleResponse -> ShowS
[UpdateBotLocaleResponse] -> ShowS
UpdateBotLocaleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBotLocaleResponse] -> ShowS
$cshowList :: [UpdateBotLocaleResponse] -> ShowS
show :: UpdateBotLocaleResponse -> String
$cshow :: UpdateBotLocaleResponse -> String
showsPrec :: Int -> UpdateBotLocaleResponse -> ShowS
$cshowsPrec :: Int -> UpdateBotLocaleResponse -> ShowS
Prelude.Show, forall x. Rep UpdateBotLocaleResponse x -> UpdateBotLocaleResponse
forall x. UpdateBotLocaleResponse -> Rep UpdateBotLocaleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBotLocaleResponse x -> UpdateBotLocaleResponse
$cfrom :: forall x. UpdateBotLocaleResponse -> Rep UpdateBotLocaleResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBotLocaleResponse' 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:
--
-- 'botId', 'updateBotLocaleResponse_botId' - The identifier of the bot that contains the updated locale.
--
-- 'botLocaleStatus', 'updateBotLocaleResponse_botLocaleStatus' - The current status of the locale. When the bot status is @Built@ the
-- locale is ready for use.
--
-- 'botVersion', 'updateBotLocaleResponse_botVersion' - The version of the bot that contains the updated locale.
--
-- 'creationDateTime', 'updateBotLocaleResponse_creationDateTime' - A timestamp of the date and time that the locale was created.
--
-- 'description', 'updateBotLocaleResponse_description' - The updated description of the locale.
--
-- 'failureReasons', 'updateBotLocaleResponse_failureReasons' - If the @botLocaleStatus@ is @Failed@, the @failureReasons@ field lists
-- the errors that occurred while building the bot.
--
-- 'lastUpdatedDateTime', 'updateBotLocaleResponse_lastUpdatedDateTime' - A timestamp of the date and time that the locale was last updated.
--
-- 'localeId', 'updateBotLocaleResponse_localeId' - The language and locale of the updated bot locale.
--
-- 'localeName', 'updateBotLocaleResponse_localeName' - The updated locale name for the locale.
--
-- 'nluIntentConfidenceThreshold', 'updateBotLocaleResponse_nluIntentConfidenceThreshold' - The updated confidence threshold for inserting the
-- @AMAZON.FallbackIntent@ and @AMAZON.KendraSearchIntent@ intents in the
-- list of possible intents for an utterance.
--
-- 'recommendedActions', 'updateBotLocaleResponse_recommendedActions' - Recommended actions to take to resolve an error in the @failureReasons@
-- field.
--
-- 'voiceSettings', 'updateBotLocaleResponse_voiceSettings' - The updated Amazon Polly voice to use for voice interaction with the
-- user.
--
-- 'httpStatus', 'updateBotLocaleResponse_httpStatus' - The response's http status code.
newUpdateBotLocaleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateBotLocaleResponse
newUpdateBotLocaleResponse :: Int -> UpdateBotLocaleResponse
newUpdateBotLocaleResponse Int
pHttpStatus_ =
  UpdateBotLocaleResponse'
    { $sel:botId:UpdateBotLocaleResponse' :: Maybe Text
botId = forall a. Maybe a
Prelude.Nothing,
      $sel:botLocaleStatus:UpdateBotLocaleResponse' :: Maybe BotLocaleStatus
botLocaleStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:UpdateBotLocaleResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:UpdateBotLocaleResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateBotLocaleResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReasons:UpdateBotLocaleResponse' :: Maybe [Text]
failureReasons = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedDateTime:UpdateBotLocaleResponse' :: Maybe POSIX
lastUpdatedDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:localeId:UpdateBotLocaleResponse' :: Maybe Text
localeId = forall a. Maybe a
Prelude.Nothing,
      $sel:localeName:UpdateBotLocaleResponse' :: Maybe Text
localeName = forall a. Maybe a
Prelude.Nothing,
      $sel:nluIntentConfidenceThreshold:UpdateBotLocaleResponse' :: Maybe Double
nluIntentConfidenceThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:recommendedActions:UpdateBotLocaleResponse' :: Maybe [Text]
recommendedActions = forall a. Maybe a
Prelude.Nothing,
      $sel:voiceSettings:UpdateBotLocaleResponse' :: Maybe VoiceSettings
voiceSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateBotLocaleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the bot that contains the updated locale.
updateBotLocaleResponse_botId :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.Text)
updateBotLocaleResponse_botId :: Lens' UpdateBotLocaleResponse (Maybe Text)
updateBotLocaleResponse_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe Text
botId :: Maybe Text
$sel:botId:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
botId} -> Maybe Text
botId) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe Text
a -> UpdateBotLocaleResponse
s {$sel:botId:UpdateBotLocaleResponse' :: Maybe Text
botId = Maybe Text
a} :: UpdateBotLocaleResponse)

-- | The current status of the locale. When the bot status is @Built@ the
-- locale is ready for use.
updateBotLocaleResponse_botLocaleStatus :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe BotLocaleStatus)
updateBotLocaleResponse_botLocaleStatus :: Lens' UpdateBotLocaleResponse (Maybe BotLocaleStatus)
updateBotLocaleResponse_botLocaleStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe BotLocaleStatus
botLocaleStatus :: Maybe BotLocaleStatus
$sel:botLocaleStatus:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe BotLocaleStatus
botLocaleStatus} -> Maybe BotLocaleStatus
botLocaleStatus) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe BotLocaleStatus
a -> UpdateBotLocaleResponse
s {$sel:botLocaleStatus:UpdateBotLocaleResponse' :: Maybe BotLocaleStatus
botLocaleStatus = Maybe BotLocaleStatus
a} :: UpdateBotLocaleResponse)

-- | The version of the bot that contains the updated locale.
updateBotLocaleResponse_botVersion :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.Text)
updateBotLocaleResponse_botVersion :: Lens' UpdateBotLocaleResponse (Maybe Text)
updateBotLocaleResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe Text
a -> UpdateBotLocaleResponse
s {$sel:botVersion:UpdateBotLocaleResponse' :: Maybe Text
botVersion = Maybe Text
a} :: UpdateBotLocaleResponse)

-- | A timestamp of the date and time that the locale was created.
updateBotLocaleResponse_creationDateTime :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.UTCTime)
updateBotLocaleResponse_creationDateTime :: Lens' UpdateBotLocaleResponse (Maybe UTCTime)
updateBotLocaleResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe POSIX
a -> UpdateBotLocaleResponse
s {$sel:creationDateTime:UpdateBotLocaleResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: UpdateBotLocaleResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The updated description of the locale.
updateBotLocaleResponse_description :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.Text)
updateBotLocaleResponse_description :: Lens' UpdateBotLocaleResponse (Maybe Text)
updateBotLocaleResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe Text
description :: Maybe Text
$sel:description:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe Text
a -> UpdateBotLocaleResponse
s {$sel:description:UpdateBotLocaleResponse' :: Maybe Text
description = Maybe Text
a} :: UpdateBotLocaleResponse)

-- | If the @botLocaleStatus@ is @Failed@, the @failureReasons@ field lists
-- the errors that occurred while building the bot.
updateBotLocaleResponse_failureReasons :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe [Prelude.Text])
updateBotLocaleResponse_failureReasons :: Lens' UpdateBotLocaleResponse (Maybe [Text])
updateBotLocaleResponse_failureReasons = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe [Text]
failureReasons :: Maybe [Text]
$sel:failureReasons:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe [Text]
failureReasons} -> Maybe [Text]
failureReasons) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe [Text]
a -> UpdateBotLocaleResponse
s {$sel:failureReasons:UpdateBotLocaleResponse' :: Maybe [Text]
failureReasons = Maybe [Text]
a} :: UpdateBotLocaleResponse) 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

-- | A timestamp of the date and time that the locale was last updated.
updateBotLocaleResponse_lastUpdatedDateTime :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.UTCTime)
updateBotLocaleResponse_lastUpdatedDateTime :: Lens' UpdateBotLocaleResponse (Maybe UTCTime)
updateBotLocaleResponse_lastUpdatedDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe POSIX
lastUpdatedDateTime :: Maybe POSIX
$sel:lastUpdatedDateTime:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe POSIX
lastUpdatedDateTime} -> Maybe POSIX
lastUpdatedDateTime) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe POSIX
a -> UpdateBotLocaleResponse
s {$sel:lastUpdatedDateTime:UpdateBotLocaleResponse' :: Maybe POSIX
lastUpdatedDateTime = Maybe POSIX
a} :: UpdateBotLocaleResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The language and locale of the updated bot locale.
updateBotLocaleResponse_localeId :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.Text)
updateBotLocaleResponse_localeId :: Lens' UpdateBotLocaleResponse (Maybe Text)
updateBotLocaleResponse_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe Text
localeId :: Maybe Text
$sel:localeId:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
localeId} -> Maybe Text
localeId) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe Text
a -> UpdateBotLocaleResponse
s {$sel:localeId:UpdateBotLocaleResponse' :: Maybe Text
localeId = Maybe Text
a} :: UpdateBotLocaleResponse)

-- | The updated locale name for the locale.
updateBotLocaleResponse_localeName :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.Text)
updateBotLocaleResponse_localeName :: Lens' UpdateBotLocaleResponse (Maybe Text)
updateBotLocaleResponse_localeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe Text
localeName :: Maybe Text
$sel:localeName:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
localeName} -> Maybe Text
localeName) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe Text
a -> UpdateBotLocaleResponse
s {$sel:localeName:UpdateBotLocaleResponse' :: Maybe Text
localeName = Maybe Text
a} :: UpdateBotLocaleResponse)

-- | The updated confidence threshold for inserting the
-- @AMAZON.FallbackIntent@ and @AMAZON.KendraSearchIntent@ intents in the
-- list of possible intents for an utterance.
updateBotLocaleResponse_nluIntentConfidenceThreshold :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe Prelude.Double)
updateBotLocaleResponse_nluIntentConfidenceThreshold :: Lens' UpdateBotLocaleResponse (Maybe Double)
updateBotLocaleResponse_nluIntentConfidenceThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe Double
nluIntentConfidenceThreshold :: Maybe Double
$sel:nluIntentConfidenceThreshold:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Double
nluIntentConfidenceThreshold} -> Maybe Double
nluIntentConfidenceThreshold) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe Double
a -> UpdateBotLocaleResponse
s {$sel:nluIntentConfidenceThreshold:UpdateBotLocaleResponse' :: Maybe Double
nluIntentConfidenceThreshold = Maybe Double
a} :: UpdateBotLocaleResponse)

-- | Recommended actions to take to resolve an error in the @failureReasons@
-- field.
updateBotLocaleResponse_recommendedActions :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe [Prelude.Text])
updateBotLocaleResponse_recommendedActions :: Lens' UpdateBotLocaleResponse (Maybe [Text])
updateBotLocaleResponse_recommendedActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe [Text]
recommendedActions :: Maybe [Text]
$sel:recommendedActions:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe [Text]
recommendedActions} -> Maybe [Text]
recommendedActions) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe [Text]
a -> UpdateBotLocaleResponse
s {$sel:recommendedActions:UpdateBotLocaleResponse' :: Maybe [Text]
recommendedActions = Maybe [Text]
a} :: UpdateBotLocaleResponse) 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 updated Amazon Polly voice to use for voice interaction with the
-- user.
updateBotLocaleResponse_voiceSettings :: Lens.Lens' UpdateBotLocaleResponse (Prelude.Maybe VoiceSettings)
updateBotLocaleResponse_voiceSettings :: Lens' UpdateBotLocaleResponse (Maybe VoiceSettings)
updateBotLocaleResponse_voiceSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotLocaleResponse' {Maybe VoiceSettings
voiceSettings :: Maybe VoiceSettings
$sel:voiceSettings:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe VoiceSettings
voiceSettings} -> Maybe VoiceSettings
voiceSettings) (\s :: UpdateBotLocaleResponse
s@UpdateBotLocaleResponse' {} Maybe VoiceSettings
a -> UpdateBotLocaleResponse
s {$sel:voiceSettings:UpdateBotLocaleResponse' :: Maybe VoiceSettings
voiceSettings = Maybe VoiceSettings
a} :: UpdateBotLocaleResponse)

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

instance Prelude.NFData UpdateBotLocaleResponse where
  rnf :: UpdateBotLocaleResponse -> ()
rnf UpdateBotLocaleResponse' {Int
Maybe Double
Maybe [Text]
Maybe Text
Maybe POSIX
Maybe BotLocaleStatus
Maybe VoiceSettings
httpStatus :: Int
voiceSettings :: Maybe VoiceSettings
recommendedActions :: Maybe [Text]
nluIntentConfidenceThreshold :: Maybe Double
localeName :: Maybe Text
localeId :: Maybe Text
lastUpdatedDateTime :: Maybe POSIX
failureReasons :: Maybe [Text]
description :: Maybe Text
creationDateTime :: Maybe POSIX
botVersion :: Maybe Text
botLocaleStatus :: Maybe BotLocaleStatus
botId :: Maybe Text
$sel:httpStatus:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Int
$sel:voiceSettings:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe VoiceSettings
$sel:recommendedActions:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe [Text]
$sel:nluIntentConfidenceThreshold:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Double
$sel:localeName:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
$sel:localeId:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
$sel:lastUpdatedDateTime:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe POSIX
$sel:failureReasons:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe [Text]
$sel:description:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
$sel:creationDateTime:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe POSIX
$sel:botVersion:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
$sel:botLocaleStatus:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe BotLocaleStatus
$sel:botId:UpdateBotLocaleResponse' :: UpdateBotLocaleResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BotLocaleStatus
botLocaleStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDateTime
      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]
failureReasons
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
localeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
localeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
nluIntentConfidenceThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
recommendedActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VoiceSettings
voiceSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus