{-# 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.DescribeBotRecommendation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides metadata information about a bot recommendation. This
-- information will enable you to get a description on the request inputs,
-- to download associated transcripts after processing is complete, and to
-- download intents and slot-types generated by the bot recommendation.
module Amazonka.LexV2Models.DescribeBotRecommendation
  ( -- * Creating a Request
    DescribeBotRecommendation (..),
    newDescribeBotRecommendation,

    -- * Request Lenses
    describeBotRecommendation_botId,
    describeBotRecommendation_botVersion,
    describeBotRecommendation_localeId,
    describeBotRecommendation_botRecommendationId,

    -- * Destructuring the Response
    DescribeBotRecommendationResponse (..),
    newDescribeBotRecommendationResponse,

    -- * Response Lenses
    describeBotRecommendationResponse_botId,
    describeBotRecommendationResponse_botRecommendationId,
    describeBotRecommendationResponse_botRecommendationResults,
    describeBotRecommendationResponse_botRecommendationStatus,
    describeBotRecommendationResponse_botVersion,
    describeBotRecommendationResponse_creationDateTime,
    describeBotRecommendationResponse_encryptionSetting,
    describeBotRecommendationResponse_failureReasons,
    describeBotRecommendationResponse_lastUpdatedDateTime,
    describeBotRecommendationResponse_localeId,
    describeBotRecommendationResponse_transcriptSourceSetting,
    describeBotRecommendationResponse_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:/ 'newDescribeBotRecommendation' smart constructor.
data DescribeBotRecommendation = DescribeBotRecommendation'
  { -- | The unique identifier of the bot associated with the bot recommendation.
    DescribeBotRecommendation -> Text
botId :: Prelude.Text,
    -- | The version of the bot associated with the bot recommendation.
    DescribeBotRecommendation -> Text
botVersion :: Prelude.Text,
    -- | The identifier of the language and locale of the bot recommendation to
    -- describe. 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>.
    DescribeBotRecommendation -> Text
localeId :: Prelude.Text,
    -- | The identifier of the bot recommendation to describe.
    DescribeBotRecommendation -> Text
botRecommendationId :: Prelude.Text
  }
  deriving (DescribeBotRecommendation -> DescribeBotRecommendation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBotRecommendation -> DescribeBotRecommendation -> Bool
$c/= :: DescribeBotRecommendation -> DescribeBotRecommendation -> Bool
== :: DescribeBotRecommendation -> DescribeBotRecommendation -> Bool
$c== :: DescribeBotRecommendation -> DescribeBotRecommendation -> Bool
Prelude.Eq, ReadPrec [DescribeBotRecommendation]
ReadPrec DescribeBotRecommendation
Int -> ReadS DescribeBotRecommendation
ReadS [DescribeBotRecommendation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBotRecommendation]
$creadListPrec :: ReadPrec [DescribeBotRecommendation]
readPrec :: ReadPrec DescribeBotRecommendation
$creadPrec :: ReadPrec DescribeBotRecommendation
readList :: ReadS [DescribeBotRecommendation]
$creadList :: ReadS [DescribeBotRecommendation]
readsPrec :: Int -> ReadS DescribeBotRecommendation
$creadsPrec :: Int -> ReadS DescribeBotRecommendation
Prelude.Read, Int -> DescribeBotRecommendation -> ShowS
[DescribeBotRecommendation] -> ShowS
DescribeBotRecommendation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBotRecommendation] -> ShowS
$cshowList :: [DescribeBotRecommendation] -> ShowS
show :: DescribeBotRecommendation -> String
$cshow :: DescribeBotRecommendation -> String
showsPrec :: Int -> DescribeBotRecommendation -> ShowS
$cshowsPrec :: Int -> DescribeBotRecommendation -> ShowS
Prelude.Show, forall x.
Rep DescribeBotRecommendation x -> DescribeBotRecommendation
forall x.
DescribeBotRecommendation -> Rep DescribeBotRecommendation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeBotRecommendation x -> DescribeBotRecommendation
$cfrom :: forall x.
DescribeBotRecommendation -> Rep DescribeBotRecommendation x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBotRecommendation' 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', 'describeBotRecommendation_botId' - The unique identifier of the bot associated with the bot recommendation.
--
-- 'botVersion', 'describeBotRecommendation_botVersion' - The version of the bot associated with the bot recommendation.
--
-- 'localeId', 'describeBotRecommendation_localeId' - The identifier of the language and locale of the bot recommendation to
-- describe. 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>.
--
-- 'botRecommendationId', 'describeBotRecommendation_botRecommendationId' - The identifier of the bot recommendation to describe.
newDescribeBotRecommendation ::
  -- | 'botId'
  Prelude.Text ->
  -- | 'botVersion'
  Prelude.Text ->
  -- | 'localeId'
  Prelude.Text ->
  -- | 'botRecommendationId'
  Prelude.Text ->
  DescribeBotRecommendation
newDescribeBotRecommendation :: Text -> Text -> Text -> Text -> DescribeBotRecommendation
newDescribeBotRecommendation
  Text
pBotId_
  Text
pBotVersion_
  Text
pLocaleId_
  Text
pBotRecommendationId_ =
    DescribeBotRecommendation'
      { $sel:botId:DescribeBotRecommendation' :: Text
botId = Text
pBotId_,
        $sel:botVersion:DescribeBotRecommendation' :: Text
botVersion = Text
pBotVersion_,
        $sel:localeId:DescribeBotRecommendation' :: Text
localeId = Text
pLocaleId_,
        $sel:botRecommendationId:DescribeBotRecommendation' :: Text
botRecommendationId = Text
pBotRecommendationId_
      }

-- | The unique identifier of the bot associated with the bot recommendation.
describeBotRecommendation_botId :: Lens.Lens' DescribeBotRecommendation Prelude.Text
describeBotRecommendation_botId :: Lens' DescribeBotRecommendation Text
describeBotRecommendation_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendation' {Text
botId :: Text
$sel:botId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
botId} -> Text
botId) (\s :: DescribeBotRecommendation
s@DescribeBotRecommendation' {} Text
a -> DescribeBotRecommendation
s {$sel:botId:DescribeBotRecommendation' :: Text
botId = Text
a} :: DescribeBotRecommendation)

-- | The version of the bot associated with the bot recommendation.
describeBotRecommendation_botVersion :: Lens.Lens' DescribeBotRecommendation Prelude.Text
describeBotRecommendation_botVersion :: Lens' DescribeBotRecommendation Text
describeBotRecommendation_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendation' {Text
botVersion :: Text
$sel:botVersion:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
botVersion} -> Text
botVersion) (\s :: DescribeBotRecommendation
s@DescribeBotRecommendation' {} Text
a -> DescribeBotRecommendation
s {$sel:botVersion:DescribeBotRecommendation' :: Text
botVersion = Text
a} :: DescribeBotRecommendation)

-- | The identifier of the language and locale of the bot recommendation to
-- describe. 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>.
describeBotRecommendation_localeId :: Lens.Lens' DescribeBotRecommendation Prelude.Text
describeBotRecommendation_localeId :: Lens' DescribeBotRecommendation Text
describeBotRecommendation_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendation' {Text
localeId :: Text
$sel:localeId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
localeId} -> Text
localeId) (\s :: DescribeBotRecommendation
s@DescribeBotRecommendation' {} Text
a -> DescribeBotRecommendation
s {$sel:localeId:DescribeBotRecommendation' :: Text
localeId = Text
a} :: DescribeBotRecommendation)

-- | The identifier of the bot recommendation to describe.
describeBotRecommendation_botRecommendationId :: Lens.Lens' DescribeBotRecommendation Prelude.Text
describeBotRecommendation_botRecommendationId :: Lens' DescribeBotRecommendation Text
describeBotRecommendation_botRecommendationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendation' {Text
botRecommendationId :: Text
$sel:botRecommendationId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
botRecommendationId} -> Text
botRecommendationId) (\s :: DescribeBotRecommendation
s@DescribeBotRecommendation' {} Text
a -> DescribeBotRecommendation
s {$sel:botRecommendationId:DescribeBotRecommendation' :: Text
botRecommendationId = Text
a} :: DescribeBotRecommendation)

instance Core.AWSRequest DescribeBotRecommendation where
  type
    AWSResponse DescribeBotRecommendation =
      DescribeBotRecommendationResponse
  request :: (Service -> Service)
-> DescribeBotRecommendation -> Request DescribeBotRecommendation
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeBotRecommendation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeBotRecommendation)))
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 Text
-> Maybe BotRecommendationResults
-> Maybe BotRecommendationStatus
-> Maybe Text
-> Maybe POSIX
-> Maybe EncryptionSetting
-> Maybe [Text]
-> Maybe POSIX
-> Maybe Text
-> Maybe TranscriptSourceSetting
-> Int
-> DescribeBotRecommendationResponse
DescribeBotRecommendationResponse'
            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
"botRecommendationId")
            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
"botRecommendationResults")
            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
"botRecommendationStatus")
            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
"encryptionSetting")
            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
"transcriptSourceSetting")
            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 DescribeBotRecommendation where
  hashWithSalt :: Int -> DescribeBotRecommendation -> Int
hashWithSalt Int
_salt DescribeBotRecommendation' {Text
botRecommendationId :: Text
localeId :: Text
botVersion :: Text
botId :: Text
$sel:botRecommendationId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:localeId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:botVersion:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:botId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
..} =
    Int
_salt
      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` Text
botRecommendationId

instance Prelude.NFData DescribeBotRecommendation where
  rnf :: DescribeBotRecommendation -> ()
rnf DescribeBotRecommendation' {Text
botRecommendationId :: Text
localeId :: Text
botVersion :: Text
botId :: Text
$sel:botRecommendationId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:localeId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:botVersion:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:botId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
..} =
    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 Text
botRecommendationId

instance Data.ToHeaders DescribeBotRecommendation where
  toHeaders :: DescribeBotRecommendation -> 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.ToPath DescribeBotRecommendation where
  toPath :: DescribeBotRecommendation -> ByteString
toPath DescribeBotRecommendation' {Text
botRecommendationId :: Text
localeId :: Text
botVersion :: Text
botId :: Text
$sel:botRecommendationId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:localeId:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:botVersion:DescribeBotRecommendation' :: DescribeBotRecommendation -> Text
$sel:botId:DescribeBotRecommendation' :: DescribeBotRecommendation -> 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
"/botrecommendations/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botRecommendationId,
        ByteString
"/"
      ]

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

-- | /See:/ 'newDescribeBotRecommendationResponse' smart constructor.
data DescribeBotRecommendationResponse = DescribeBotRecommendationResponse'
  { -- | The identifier of the bot associated with the bot recommendation.
    DescribeBotRecommendationResponse -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the bot recommendation being described.
    DescribeBotRecommendationResponse -> Maybe Text
botRecommendationId :: Prelude.Maybe Prelude.Text,
    -- | The object representing the URL of the bot definition, the URL of the
    -- associated transcript and a statistical summary of the bot
    -- recommendation results.
    DescribeBotRecommendationResponse -> Maybe BotRecommendationResults
botRecommendationResults :: Prelude.Maybe BotRecommendationResults,
    -- | The status of the bot recommendation. If the status is Failed, then the
    -- reasons for the failure are listed in the failureReasons field.
    DescribeBotRecommendationResponse -> Maybe BotRecommendationStatus
botRecommendationStatus :: Prelude.Maybe BotRecommendationStatus,
    -- | The version of the bot associated with the bot recommendation.
    DescribeBotRecommendationResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | The date and time that the bot recommendation was created.
    DescribeBotRecommendationResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The object representing the passwords that were used to encrypt the data
    -- related to the bot recommendation results, as well as the KMS key ARN
    -- used to encrypt the associated metadata.
    DescribeBotRecommendationResponse -> Maybe EncryptionSetting
encryptionSetting :: Prelude.Maybe EncryptionSetting,
    -- | If botRecommendationStatus is Failed, Amazon Lex explains why.
    DescribeBotRecommendationResponse -> Maybe [Text]
failureReasons :: Prelude.Maybe [Prelude.Text],
    -- | The date and time that the bot recommendation was last updated.
    DescribeBotRecommendationResponse -> Maybe POSIX
lastUpdatedDateTime :: Prelude.Maybe Data.POSIX,
    -- | The identifier of the language and locale of the bot recommendation to
    -- describe.
    DescribeBotRecommendationResponse -> Maybe Text
localeId :: Prelude.Maybe Prelude.Text,
    -- | The object representing the Amazon S3 bucket containing the transcript,
    -- as well as the associated metadata.
    DescribeBotRecommendationResponse -> Maybe TranscriptSourceSetting
transcriptSourceSetting :: Prelude.Maybe TranscriptSourceSetting,
    -- | The response's http status code.
    DescribeBotRecommendationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeBotRecommendationResponse
-> DescribeBotRecommendationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBotRecommendationResponse
-> DescribeBotRecommendationResponse -> Bool
$c/= :: DescribeBotRecommendationResponse
-> DescribeBotRecommendationResponse -> Bool
== :: DescribeBotRecommendationResponse
-> DescribeBotRecommendationResponse -> Bool
$c== :: DescribeBotRecommendationResponse
-> DescribeBotRecommendationResponse -> Bool
Prelude.Eq, Int -> DescribeBotRecommendationResponse -> ShowS
[DescribeBotRecommendationResponse] -> ShowS
DescribeBotRecommendationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBotRecommendationResponse] -> ShowS
$cshowList :: [DescribeBotRecommendationResponse] -> ShowS
show :: DescribeBotRecommendationResponse -> String
$cshow :: DescribeBotRecommendationResponse -> String
showsPrec :: Int -> DescribeBotRecommendationResponse -> ShowS
$cshowsPrec :: Int -> DescribeBotRecommendationResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeBotRecommendationResponse x
-> DescribeBotRecommendationResponse
forall x.
DescribeBotRecommendationResponse
-> Rep DescribeBotRecommendationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeBotRecommendationResponse x
-> DescribeBotRecommendationResponse
$cfrom :: forall x.
DescribeBotRecommendationResponse
-> Rep DescribeBotRecommendationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBotRecommendationResponse' 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', 'describeBotRecommendationResponse_botId' - The identifier of the bot associated with the bot recommendation.
--
-- 'botRecommendationId', 'describeBotRecommendationResponse_botRecommendationId' - The identifier of the bot recommendation being described.
--
-- 'botRecommendationResults', 'describeBotRecommendationResponse_botRecommendationResults' - The object representing the URL of the bot definition, the URL of the
-- associated transcript and a statistical summary of the bot
-- recommendation results.
--
-- 'botRecommendationStatus', 'describeBotRecommendationResponse_botRecommendationStatus' - The status of the bot recommendation. If the status is Failed, then the
-- reasons for the failure are listed in the failureReasons field.
--
-- 'botVersion', 'describeBotRecommendationResponse_botVersion' - The version of the bot associated with the bot recommendation.
--
-- 'creationDateTime', 'describeBotRecommendationResponse_creationDateTime' - The date and time that the bot recommendation was created.
--
-- 'encryptionSetting', 'describeBotRecommendationResponse_encryptionSetting' - The object representing the passwords that were used to encrypt the data
-- related to the bot recommendation results, as well as the KMS key ARN
-- used to encrypt the associated metadata.
--
-- 'failureReasons', 'describeBotRecommendationResponse_failureReasons' - If botRecommendationStatus is Failed, Amazon Lex explains why.
--
-- 'lastUpdatedDateTime', 'describeBotRecommendationResponse_lastUpdatedDateTime' - The date and time that the bot recommendation was last updated.
--
-- 'localeId', 'describeBotRecommendationResponse_localeId' - The identifier of the language and locale of the bot recommendation to
-- describe.
--
-- 'transcriptSourceSetting', 'describeBotRecommendationResponse_transcriptSourceSetting' - The object representing the Amazon S3 bucket containing the transcript,
-- as well as the associated metadata.
--
-- 'httpStatus', 'describeBotRecommendationResponse_httpStatus' - The response's http status code.
newDescribeBotRecommendationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeBotRecommendationResponse
newDescribeBotRecommendationResponse :: Int -> DescribeBotRecommendationResponse
newDescribeBotRecommendationResponse Int
pHttpStatus_ =
  DescribeBotRecommendationResponse'
    { $sel:botId:DescribeBotRecommendationResponse' :: Maybe Text
botId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:botRecommendationId:DescribeBotRecommendationResponse' :: Maybe Text
botRecommendationId = forall a. Maybe a
Prelude.Nothing,
      $sel:botRecommendationResults:DescribeBotRecommendationResponse' :: Maybe BotRecommendationResults
botRecommendationResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:botRecommendationStatus:DescribeBotRecommendationResponse' :: Maybe BotRecommendationStatus
botRecommendationStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:DescribeBotRecommendationResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:DescribeBotRecommendationResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionSetting:DescribeBotRecommendationResponse' :: Maybe EncryptionSetting
encryptionSetting = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReasons:DescribeBotRecommendationResponse' :: Maybe [Text]
failureReasons = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedDateTime:DescribeBotRecommendationResponse' :: Maybe POSIX
lastUpdatedDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:localeId:DescribeBotRecommendationResponse' :: Maybe Text
localeId = forall a. Maybe a
Prelude.Nothing,
      $sel:transcriptSourceSetting:DescribeBotRecommendationResponse' :: Maybe TranscriptSourceSetting
transcriptSourceSetting =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeBotRecommendationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the bot associated with the bot recommendation.
describeBotRecommendationResponse_botId :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe Prelude.Text)
describeBotRecommendationResponse_botId :: Lens' DescribeBotRecommendationResponse (Maybe Text)
describeBotRecommendationResponse_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe Text
botId :: Maybe Text
$sel:botId:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe Text
botId} -> Maybe Text
botId) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe Text
a -> DescribeBotRecommendationResponse
s {$sel:botId:DescribeBotRecommendationResponse' :: Maybe Text
botId = Maybe Text
a} :: DescribeBotRecommendationResponse)

-- | The identifier of the bot recommendation being described.
describeBotRecommendationResponse_botRecommendationId :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe Prelude.Text)
describeBotRecommendationResponse_botRecommendationId :: Lens' DescribeBotRecommendationResponse (Maybe Text)
describeBotRecommendationResponse_botRecommendationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe Text
botRecommendationId :: Maybe Text
$sel:botRecommendationId:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe Text
botRecommendationId} -> Maybe Text
botRecommendationId) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe Text
a -> DescribeBotRecommendationResponse
s {$sel:botRecommendationId:DescribeBotRecommendationResponse' :: Maybe Text
botRecommendationId = Maybe Text
a} :: DescribeBotRecommendationResponse)

-- | The object representing the URL of the bot definition, the URL of the
-- associated transcript and a statistical summary of the bot
-- recommendation results.
describeBotRecommendationResponse_botRecommendationResults :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe BotRecommendationResults)
describeBotRecommendationResponse_botRecommendationResults :: Lens'
  DescribeBotRecommendationResponse (Maybe BotRecommendationResults)
describeBotRecommendationResponse_botRecommendationResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe BotRecommendationResults
botRecommendationResults :: Maybe BotRecommendationResults
$sel:botRecommendationResults:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe BotRecommendationResults
botRecommendationResults} -> Maybe BotRecommendationResults
botRecommendationResults) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe BotRecommendationResults
a -> DescribeBotRecommendationResponse
s {$sel:botRecommendationResults:DescribeBotRecommendationResponse' :: Maybe BotRecommendationResults
botRecommendationResults = Maybe BotRecommendationResults
a} :: DescribeBotRecommendationResponse)

-- | The status of the bot recommendation. If the status is Failed, then the
-- reasons for the failure are listed in the failureReasons field.
describeBotRecommendationResponse_botRecommendationStatus :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe BotRecommendationStatus)
describeBotRecommendationResponse_botRecommendationStatus :: Lens'
  DescribeBotRecommendationResponse (Maybe BotRecommendationStatus)
describeBotRecommendationResponse_botRecommendationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe BotRecommendationStatus
botRecommendationStatus :: Maybe BotRecommendationStatus
$sel:botRecommendationStatus:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe BotRecommendationStatus
botRecommendationStatus} -> Maybe BotRecommendationStatus
botRecommendationStatus) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe BotRecommendationStatus
a -> DescribeBotRecommendationResponse
s {$sel:botRecommendationStatus:DescribeBotRecommendationResponse' :: Maybe BotRecommendationStatus
botRecommendationStatus = Maybe BotRecommendationStatus
a} :: DescribeBotRecommendationResponse)

-- | The version of the bot associated with the bot recommendation.
describeBotRecommendationResponse_botVersion :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe Prelude.Text)
describeBotRecommendationResponse_botVersion :: Lens' DescribeBotRecommendationResponse (Maybe Text)
describeBotRecommendationResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe Text
a -> DescribeBotRecommendationResponse
s {$sel:botVersion:DescribeBotRecommendationResponse' :: Maybe Text
botVersion = Maybe Text
a} :: DescribeBotRecommendationResponse)

-- | The date and time that the bot recommendation was created.
describeBotRecommendationResponse_creationDateTime :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe Prelude.UTCTime)
describeBotRecommendationResponse_creationDateTime :: Lens' DescribeBotRecommendationResponse (Maybe UTCTime)
describeBotRecommendationResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe POSIX
a -> DescribeBotRecommendationResponse
s {$sel:creationDateTime:DescribeBotRecommendationResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: DescribeBotRecommendationResponse) 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 object representing the passwords that were used to encrypt the data
-- related to the bot recommendation results, as well as the KMS key ARN
-- used to encrypt the associated metadata.
describeBotRecommendationResponse_encryptionSetting :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe EncryptionSetting)
describeBotRecommendationResponse_encryptionSetting :: Lens' DescribeBotRecommendationResponse (Maybe EncryptionSetting)
describeBotRecommendationResponse_encryptionSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe EncryptionSetting
encryptionSetting :: Maybe EncryptionSetting
$sel:encryptionSetting:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe EncryptionSetting
encryptionSetting} -> Maybe EncryptionSetting
encryptionSetting) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe EncryptionSetting
a -> DescribeBotRecommendationResponse
s {$sel:encryptionSetting:DescribeBotRecommendationResponse' :: Maybe EncryptionSetting
encryptionSetting = Maybe EncryptionSetting
a} :: DescribeBotRecommendationResponse)

-- | If botRecommendationStatus is Failed, Amazon Lex explains why.
describeBotRecommendationResponse_failureReasons :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe [Prelude.Text])
describeBotRecommendationResponse_failureReasons :: Lens' DescribeBotRecommendationResponse (Maybe [Text])
describeBotRecommendationResponse_failureReasons = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe [Text]
failureReasons :: Maybe [Text]
$sel:failureReasons:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe [Text]
failureReasons} -> Maybe [Text]
failureReasons) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe [Text]
a -> DescribeBotRecommendationResponse
s {$sel:failureReasons:DescribeBotRecommendationResponse' :: Maybe [Text]
failureReasons = Maybe [Text]
a} :: DescribeBotRecommendationResponse) 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 date and time that the bot recommendation was last updated.
describeBotRecommendationResponse_lastUpdatedDateTime :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe Prelude.UTCTime)
describeBotRecommendationResponse_lastUpdatedDateTime :: Lens' DescribeBotRecommendationResponse (Maybe UTCTime)
describeBotRecommendationResponse_lastUpdatedDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe POSIX
lastUpdatedDateTime :: Maybe POSIX
$sel:lastUpdatedDateTime:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe POSIX
lastUpdatedDateTime} -> Maybe POSIX
lastUpdatedDateTime) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe POSIX
a -> DescribeBotRecommendationResponse
s {$sel:lastUpdatedDateTime:DescribeBotRecommendationResponse' :: Maybe POSIX
lastUpdatedDateTime = Maybe POSIX
a} :: DescribeBotRecommendationResponse) 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 identifier of the language and locale of the bot recommendation to
-- describe.
describeBotRecommendationResponse_localeId :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe Prelude.Text)
describeBotRecommendationResponse_localeId :: Lens' DescribeBotRecommendationResponse (Maybe Text)
describeBotRecommendationResponse_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe Text
localeId :: Maybe Text
$sel:localeId:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe Text
localeId} -> Maybe Text
localeId) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe Text
a -> DescribeBotRecommendationResponse
s {$sel:localeId:DescribeBotRecommendationResponse' :: Maybe Text
localeId = Maybe Text
a} :: DescribeBotRecommendationResponse)

-- | The object representing the Amazon S3 bucket containing the transcript,
-- as well as the associated metadata.
describeBotRecommendationResponse_transcriptSourceSetting :: Lens.Lens' DescribeBotRecommendationResponse (Prelude.Maybe TranscriptSourceSetting)
describeBotRecommendationResponse_transcriptSourceSetting :: Lens'
  DescribeBotRecommendationResponse (Maybe TranscriptSourceSetting)
describeBotRecommendationResponse_transcriptSourceSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotRecommendationResponse' {Maybe TranscriptSourceSetting
transcriptSourceSetting :: Maybe TranscriptSourceSetting
$sel:transcriptSourceSetting:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe TranscriptSourceSetting
transcriptSourceSetting} -> Maybe TranscriptSourceSetting
transcriptSourceSetting) (\s :: DescribeBotRecommendationResponse
s@DescribeBotRecommendationResponse' {} Maybe TranscriptSourceSetting
a -> DescribeBotRecommendationResponse
s {$sel:transcriptSourceSetting:DescribeBotRecommendationResponse' :: Maybe TranscriptSourceSetting
transcriptSourceSetting = Maybe TranscriptSourceSetting
a} :: DescribeBotRecommendationResponse)

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

instance
  Prelude.NFData
    DescribeBotRecommendationResponse
  where
  rnf :: DescribeBotRecommendationResponse -> ()
rnf DescribeBotRecommendationResponse' {Int
Maybe [Text]
Maybe Text
Maybe POSIX
Maybe BotRecommendationStatus
Maybe EncryptionSetting
Maybe BotRecommendationResults
Maybe TranscriptSourceSetting
httpStatus :: Int
transcriptSourceSetting :: Maybe TranscriptSourceSetting
localeId :: Maybe Text
lastUpdatedDateTime :: Maybe POSIX
failureReasons :: Maybe [Text]
encryptionSetting :: Maybe EncryptionSetting
creationDateTime :: Maybe POSIX
botVersion :: Maybe Text
botRecommendationStatus :: Maybe BotRecommendationStatus
botRecommendationResults :: Maybe BotRecommendationResults
botRecommendationId :: Maybe Text
botId :: Maybe Text
$sel:httpStatus:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Int
$sel:transcriptSourceSetting:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe TranscriptSourceSetting
$sel:localeId:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe Text
$sel:lastUpdatedDateTime:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe POSIX
$sel:failureReasons:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe [Text]
$sel:encryptionSetting:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe EncryptionSetting
$sel:creationDateTime:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe POSIX
$sel:botVersion:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe Text
$sel:botRecommendationStatus:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe BotRecommendationStatus
$sel:botRecommendationResults:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe BotRecommendationResults
$sel:botRecommendationId:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> Maybe Text
$sel:botId:DescribeBotRecommendationResponse' :: DescribeBotRecommendationResponse -> 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 Text
botRecommendationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BotRecommendationResults
botRecommendationResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BotRecommendationStatus
botRecommendationStatus
      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 EncryptionSetting
encryptionSetting
      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 TranscriptSourceSetting
transcriptSourceSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus