{-# 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.DescribeBotAlias
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get information about a specific bot alias.
module Amazonka.LexV2Models.DescribeBotAlias
  ( -- * Creating a Request
    DescribeBotAlias (..),
    newDescribeBotAlias,

    -- * Request Lenses
    describeBotAlias_botAliasId,
    describeBotAlias_botId,

    -- * Destructuring the Response
    DescribeBotAliasResponse (..),
    newDescribeBotAliasResponse,

    -- * Response Lenses
    describeBotAliasResponse_botAliasHistoryEvents,
    describeBotAliasResponse_botAliasId,
    describeBotAliasResponse_botAliasLocaleSettings,
    describeBotAliasResponse_botAliasName,
    describeBotAliasResponse_botAliasStatus,
    describeBotAliasResponse_botId,
    describeBotAliasResponse_botVersion,
    describeBotAliasResponse_conversationLogSettings,
    describeBotAliasResponse_creationDateTime,
    describeBotAliasResponse_description,
    describeBotAliasResponse_lastUpdatedDateTime,
    describeBotAliasResponse_sentimentAnalysisSettings,
    describeBotAliasResponse_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:/ 'newDescribeBotAlias' smart constructor.
data DescribeBotAlias = DescribeBotAlias'
  { -- | The identifier of the bot alias to describe.
    DescribeBotAlias -> Text
botAliasId :: Prelude.Text,
    -- | The identifier of the bot associated with the bot alias to describe.
    DescribeBotAlias -> Text
botId :: Prelude.Text
  }
  deriving (DescribeBotAlias -> DescribeBotAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBotAlias -> DescribeBotAlias -> Bool
$c/= :: DescribeBotAlias -> DescribeBotAlias -> Bool
== :: DescribeBotAlias -> DescribeBotAlias -> Bool
$c== :: DescribeBotAlias -> DescribeBotAlias -> Bool
Prelude.Eq, ReadPrec [DescribeBotAlias]
ReadPrec DescribeBotAlias
Int -> ReadS DescribeBotAlias
ReadS [DescribeBotAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBotAlias]
$creadListPrec :: ReadPrec [DescribeBotAlias]
readPrec :: ReadPrec DescribeBotAlias
$creadPrec :: ReadPrec DescribeBotAlias
readList :: ReadS [DescribeBotAlias]
$creadList :: ReadS [DescribeBotAlias]
readsPrec :: Int -> ReadS DescribeBotAlias
$creadsPrec :: Int -> ReadS DescribeBotAlias
Prelude.Read, Int -> DescribeBotAlias -> ShowS
[DescribeBotAlias] -> ShowS
DescribeBotAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBotAlias] -> ShowS
$cshowList :: [DescribeBotAlias] -> ShowS
show :: DescribeBotAlias -> String
$cshow :: DescribeBotAlias -> String
showsPrec :: Int -> DescribeBotAlias -> ShowS
$cshowsPrec :: Int -> DescribeBotAlias -> ShowS
Prelude.Show, forall x. Rep DescribeBotAlias x -> DescribeBotAlias
forall x. DescribeBotAlias -> Rep DescribeBotAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeBotAlias x -> DescribeBotAlias
$cfrom :: forall x. DescribeBotAlias -> Rep DescribeBotAlias x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBotAlias' 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:
--
-- 'botAliasId', 'describeBotAlias_botAliasId' - The identifier of the bot alias to describe.
--
-- 'botId', 'describeBotAlias_botId' - The identifier of the bot associated with the bot alias to describe.
newDescribeBotAlias ::
  -- | 'botAliasId'
  Prelude.Text ->
  -- | 'botId'
  Prelude.Text ->
  DescribeBotAlias
newDescribeBotAlias :: Text -> Text -> DescribeBotAlias
newDescribeBotAlias Text
pBotAliasId_ Text
pBotId_ =
  DescribeBotAlias'
    { $sel:botAliasId:DescribeBotAlias' :: Text
botAliasId = Text
pBotAliasId_,
      $sel:botId:DescribeBotAlias' :: Text
botId = Text
pBotId_
    }

-- | The identifier of the bot alias to describe.
describeBotAlias_botAliasId :: Lens.Lens' DescribeBotAlias Prelude.Text
describeBotAlias_botAliasId :: Lens' DescribeBotAlias Text
describeBotAlias_botAliasId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAlias' {Text
botAliasId :: Text
$sel:botAliasId:DescribeBotAlias' :: DescribeBotAlias -> Text
botAliasId} -> Text
botAliasId) (\s :: DescribeBotAlias
s@DescribeBotAlias' {} Text
a -> DescribeBotAlias
s {$sel:botAliasId:DescribeBotAlias' :: Text
botAliasId = Text
a} :: DescribeBotAlias)

-- | The identifier of the bot associated with the bot alias to describe.
describeBotAlias_botId :: Lens.Lens' DescribeBotAlias Prelude.Text
describeBotAlias_botId :: Lens' DescribeBotAlias Text
describeBotAlias_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAlias' {Text
botId :: Text
$sel:botId:DescribeBotAlias' :: DescribeBotAlias -> Text
botId} -> Text
botId) (\s :: DescribeBotAlias
s@DescribeBotAlias' {} Text
a -> DescribeBotAlias
s {$sel:botId:DescribeBotAlias' :: Text
botId = Text
a} :: DescribeBotAlias)

instance Core.AWSRequest DescribeBotAlias where
  type
    AWSResponse DescribeBotAlias =
      DescribeBotAliasResponse
  request :: (Service -> Service)
-> DescribeBotAlias -> Request DescribeBotAlias
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 DescribeBotAlias
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeBotAlias)))
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 [BotAliasHistoryEvent]
-> Maybe Text
-> Maybe (HashMap Text BotAliasLocaleSettings)
-> Maybe Text
-> Maybe BotAliasStatus
-> Maybe Text
-> Maybe Text
-> Maybe ConversationLogSettings
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe SentimentAnalysisSettings
-> Int
-> DescribeBotAliasResponse
DescribeBotAliasResponse'
            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
"botAliasHistoryEvents"
                            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
"botAliasId")
            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
"botAliasLocaleSettings"
                            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
"botAliasName")
            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
"botAliasStatus")
            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
"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
"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
"conversationLogSettings")
            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
"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
"sentimentAnalysisSettings")
            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 DescribeBotAlias where
  hashWithSalt :: Int -> DescribeBotAlias -> Int
hashWithSalt Int
_salt DescribeBotAlias' {Text
botId :: Text
botAliasId :: Text
$sel:botId:DescribeBotAlias' :: DescribeBotAlias -> Text
$sel:botAliasId:DescribeBotAlias' :: DescribeBotAlias -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botAliasId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botId

instance Prelude.NFData DescribeBotAlias where
  rnf :: DescribeBotAlias -> ()
rnf DescribeBotAlias' {Text
botId :: Text
botAliasId :: Text
$sel:botId:DescribeBotAlias' :: DescribeBotAlias -> Text
$sel:botAliasId:DescribeBotAlias' :: DescribeBotAlias -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
botAliasId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botId

instance Data.ToHeaders DescribeBotAlias where
  toHeaders :: DescribeBotAlias -> 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 DescribeBotAlias where
  toPath :: DescribeBotAlias -> ByteString
toPath DescribeBotAlias' {Text
botId :: Text
botAliasId :: Text
$sel:botId:DescribeBotAlias' :: DescribeBotAlias -> Text
$sel:botAliasId:DescribeBotAlias' :: DescribeBotAlias -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botId,
        ByteString
"/botaliases/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botAliasId,
        ByteString
"/"
      ]

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

-- | /See:/ 'newDescribeBotAliasResponse' smart constructor.
data DescribeBotAliasResponse = DescribeBotAliasResponse'
  { -- | A list of events that affect a bot alias. For example, an event is
    -- recorded when the version that the alias points to changes.
    DescribeBotAliasResponse -> Maybe [BotAliasHistoryEvent]
botAliasHistoryEvents :: Prelude.Maybe [BotAliasHistoryEvent],
    -- | The identifier of the bot alias.
    DescribeBotAliasResponse -> Maybe Text
botAliasId :: Prelude.Maybe Prelude.Text,
    -- | The locale settings that are unique to the alias.
    DescribeBotAliasResponse
-> Maybe (HashMap Text BotAliasLocaleSettings)
botAliasLocaleSettings :: Prelude.Maybe (Prelude.HashMap Prelude.Text BotAliasLocaleSettings),
    -- | The name of the bot alias.
    DescribeBotAliasResponse -> Maybe Text
botAliasName :: Prelude.Maybe Prelude.Text,
    -- | The current status of the alias. When the alias is @Available@, the
    -- alias is ready for use with your bot.
    DescribeBotAliasResponse -> Maybe BotAliasStatus
botAliasStatus :: Prelude.Maybe BotAliasStatus,
    -- | The identifier of the bot associated with the bot alias.
    DescribeBotAliasResponse -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | The version of the bot associated with the bot alias.
    DescribeBotAliasResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | Specifics of how Amazon Lex logs text and audio conversations with the
    -- bot associated with the alias.
    DescribeBotAliasResponse -> Maybe ConversationLogSettings
conversationLogSettings :: Prelude.Maybe ConversationLogSettings,
    -- | A timestamp of the date and time that the alias was created.
    DescribeBotAliasResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The description of the bot alias.
    DescribeBotAliasResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A timestamp of the date and time that the alias was last updated.
    DescribeBotAliasResponse -> Maybe POSIX
lastUpdatedDateTime :: Prelude.Maybe Data.POSIX,
    DescribeBotAliasResponse -> Maybe SentimentAnalysisSettings
sentimentAnalysisSettings :: Prelude.Maybe SentimentAnalysisSettings,
    -- | The response's http status code.
    DescribeBotAliasResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeBotAliasResponse -> DescribeBotAliasResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBotAliasResponse -> DescribeBotAliasResponse -> Bool
$c/= :: DescribeBotAliasResponse -> DescribeBotAliasResponse -> Bool
== :: DescribeBotAliasResponse -> DescribeBotAliasResponse -> Bool
$c== :: DescribeBotAliasResponse -> DescribeBotAliasResponse -> Bool
Prelude.Eq, ReadPrec [DescribeBotAliasResponse]
ReadPrec DescribeBotAliasResponse
Int -> ReadS DescribeBotAliasResponse
ReadS [DescribeBotAliasResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBotAliasResponse]
$creadListPrec :: ReadPrec [DescribeBotAliasResponse]
readPrec :: ReadPrec DescribeBotAliasResponse
$creadPrec :: ReadPrec DescribeBotAliasResponse
readList :: ReadS [DescribeBotAliasResponse]
$creadList :: ReadS [DescribeBotAliasResponse]
readsPrec :: Int -> ReadS DescribeBotAliasResponse
$creadsPrec :: Int -> ReadS DescribeBotAliasResponse
Prelude.Read, Int -> DescribeBotAliasResponse -> ShowS
[DescribeBotAliasResponse] -> ShowS
DescribeBotAliasResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBotAliasResponse] -> ShowS
$cshowList :: [DescribeBotAliasResponse] -> ShowS
show :: DescribeBotAliasResponse -> String
$cshow :: DescribeBotAliasResponse -> String
showsPrec :: Int -> DescribeBotAliasResponse -> ShowS
$cshowsPrec :: Int -> DescribeBotAliasResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeBotAliasResponse x -> DescribeBotAliasResponse
forall x.
DescribeBotAliasResponse -> Rep DescribeBotAliasResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeBotAliasResponse x -> DescribeBotAliasResponse
$cfrom :: forall x.
DescribeBotAliasResponse -> Rep DescribeBotAliasResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBotAliasResponse' 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:
--
-- 'botAliasHistoryEvents', 'describeBotAliasResponse_botAliasHistoryEvents' - A list of events that affect a bot alias. For example, an event is
-- recorded when the version that the alias points to changes.
--
-- 'botAliasId', 'describeBotAliasResponse_botAliasId' - The identifier of the bot alias.
--
-- 'botAliasLocaleSettings', 'describeBotAliasResponse_botAliasLocaleSettings' - The locale settings that are unique to the alias.
--
-- 'botAliasName', 'describeBotAliasResponse_botAliasName' - The name of the bot alias.
--
-- 'botAliasStatus', 'describeBotAliasResponse_botAliasStatus' - The current status of the alias. When the alias is @Available@, the
-- alias is ready for use with your bot.
--
-- 'botId', 'describeBotAliasResponse_botId' - The identifier of the bot associated with the bot alias.
--
-- 'botVersion', 'describeBotAliasResponse_botVersion' - The version of the bot associated with the bot alias.
--
-- 'conversationLogSettings', 'describeBotAliasResponse_conversationLogSettings' - Specifics of how Amazon Lex logs text and audio conversations with the
-- bot associated with the alias.
--
-- 'creationDateTime', 'describeBotAliasResponse_creationDateTime' - A timestamp of the date and time that the alias was created.
--
-- 'description', 'describeBotAliasResponse_description' - The description of the bot alias.
--
-- 'lastUpdatedDateTime', 'describeBotAliasResponse_lastUpdatedDateTime' - A timestamp of the date and time that the alias was last updated.
--
-- 'sentimentAnalysisSettings', 'describeBotAliasResponse_sentimentAnalysisSettings' - Undocumented member.
--
-- 'httpStatus', 'describeBotAliasResponse_httpStatus' - The response's http status code.
newDescribeBotAliasResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeBotAliasResponse
newDescribeBotAliasResponse :: Int -> DescribeBotAliasResponse
newDescribeBotAliasResponse Int
pHttpStatus_ =
  DescribeBotAliasResponse'
    { $sel:botAliasHistoryEvents:DescribeBotAliasResponse' :: Maybe [BotAliasHistoryEvent]
botAliasHistoryEvents =
        forall a. Maybe a
Prelude.Nothing,
      $sel:botAliasId:DescribeBotAliasResponse' :: Maybe Text
botAliasId = forall a. Maybe a
Prelude.Nothing,
      $sel:botAliasLocaleSettings:DescribeBotAliasResponse' :: Maybe (HashMap Text BotAliasLocaleSettings)
botAliasLocaleSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:botAliasName:DescribeBotAliasResponse' :: Maybe Text
botAliasName = forall a. Maybe a
Prelude.Nothing,
      $sel:botAliasStatus:DescribeBotAliasResponse' :: Maybe BotAliasStatus
botAliasStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:botId:DescribeBotAliasResponse' :: Maybe Text
botId = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:DescribeBotAliasResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:conversationLogSettings:DescribeBotAliasResponse' :: Maybe ConversationLogSettings
conversationLogSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:DescribeBotAliasResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeBotAliasResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedDateTime:DescribeBotAliasResponse' :: Maybe POSIX
lastUpdatedDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:sentimentAnalysisSettings:DescribeBotAliasResponse' :: Maybe SentimentAnalysisSettings
sentimentAnalysisSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeBotAliasResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of events that affect a bot alias. For example, an event is
-- recorded when the version that the alias points to changes.
describeBotAliasResponse_botAliasHistoryEvents :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe [BotAliasHistoryEvent])
describeBotAliasResponse_botAliasHistoryEvents :: Lens' DescribeBotAliasResponse (Maybe [BotAliasHistoryEvent])
describeBotAliasResponse_botAliasHistoryEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe [BotAliasHistoryEvent]
botAliasHistoryEvents :: Maybe [BotAliasHistoryEvent]
$sel:botAliasHistoryEvents:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe [BotAliasHistoryEvent]
botAliasHistoryEvents} -> Maybe [BotAliasHistoryEvent]
botAliasHistoryEvents) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe [BotAliasHistoryEvent]
a -> DescribeBotAliasResponse
s {$sel:botAliasHistoryEvents:DescribeBotAliasResponse' :: Maybe [BotAliasHistoryEvent]
botAliasHistoryEvents = Maybe [BotAliasHistoryEvent]
a} :: DescribeBotAliasResponse) 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 identifier of the bot alias.
describeBotAliasResponse_botAliasId :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe Prelude.Text)
describeBotAliasResponse_botAliasId :: Lens' DescribeBotAliasResponse (Maybe Text)
describeBotAliasResponse_botAliasId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe Text
botAliasId :: Maybe Text
$sel:botAliasId:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
botAliasId} -> Maybe Text
botAliasId) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe Text
a -> DescribeBotAliasResponse
s {$sel:botAliasId:DescribeBotAliasResponse' :: Maybe Text
botAliasId = Maybe Text
a} :: DescribeBotAliasResponse)

-- | The locale settings that are unique to the alias.
describeBotAliasResponse_botAliasLocaleSettings :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text BotAliasLocaleSettings))
describeBotAliasResponse_botAliasLocaleSettings :: Lens'
  DescribeBotAliasResponse
  (Maybe (HashMap Text BotAliasLocaleSettings))
describeBotAliasResponse_botAliasLocaleSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe (HashMap Text BotAliasLocaleSettings)
botAliasLocaleSettings :: Maybe (HashMap Text BotAliasLocaleSettings)
$sel:botAliasLocaleSettings:DescribeBotAliasResponse' :: DescribeBotAliasResponse
-> Maybe (HashMap Text BotAliasLocaleSettings)
botAliasLocaleSettings} -> Maybe (HashMap Text BotAliasLocaleSettings)
botAliasLocaleSettings) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe (HashMap Text BotAliasLocaleSettings)
a -> DescribeBotAliasResponse
s {$sel:botAliasLocaleSettings:DescribeBotAliasResponse' :: Maybe (HashMap Text BotAliasLocaleSettings)
botAliasLocaleSettings = Maybe (HashMap Text BotAliasLocaleSettings)
a} :: DescribeBotAliasResponse) 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 name of the bot alias.
describeBotAliasResponse_botAliasName :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe Prelude.Text)
describeBotAliasResponse_botAliasName :: Lens' DescribeBotAliasResponse (Maybe Text)
describeBotAliasResponse_botAliasName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe Text
botAliasName :: Maybe Text
$sel:botAliasName:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
botAliasName} -> Maybe Text
botAliasName) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe Text
a -> DescribeBotAliasResponse
s {$sel:botAliasName:DescribeBotAliasResponse' :: Maybe Text
botAliasName = Maybe Text
a} :: DescribeBotAliasResponse)

-- | The current status of the alias. When the alias is @Available@, the
-- alias is ready for use with your bot.
describeBotAliasResponse_botAliasStatus :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe BotAliasStatus)
describeBotAliasResponse_botAliasStatus :: Lens' DescribeBotAliasResponse (Maybe BotAliasStatus)
describeBotAliasResponse_botAliasStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe BotAliasStatus
botAliasStatus :: Maybe BotAliasStatus
$sel:botAliasStatus:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe BotAliasStatus
botAliasStatus} -> Maybe BotAliasStatus
botAliasStatus) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe BotAliasStatus
a -> DescribeBotAliasResponse
s {$sel:botAliasStatus:DescribeBotAliasResponse' :: Maybe BotAliasStatus
botAliasStatus = Maybe BotAliasStatus
a} :: DescribeBotAliasResponse)

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

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

-- | Specifics of how Amazon Lex logs text and audio conversations with the
-- bot associated with the alias.
describeBotAliasResponse_conversationLogSettings :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe ConversationLogSettings)
describeBotAliasResponse_conversationLogSettings :: Lens' DescribeBotAliasResponse (Maybe ConversationLogSettings)
describeBotAliasResponse_conversationLogSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe ConversationLogSettings
conversationLogSettings :: Maybe ConversationLogSettings
$sel:conversationLogSettings:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe ConversationLogSettings
conversationLogSettings} -> Maybe ConversationLogSettings
conversationLogSettings) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe ConversationLogSettings
a -> DescribeBotAliasResponse
s {$sel:conversationLogSettings:DescribeBotAliasResponse' :: Maybe ConversationLogSettings
conversationLogSettings = Maybe ConversationLogSettings
a} :: DescribeBotAliasResponse)

-- | A timestamp of the date and time that the alias was created.
describeBotAliasResponse_creationDateTime :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe Prelude.UTCTime)
describeBotAliasResponse_creationDateTime :: Lens' DescribeBotAliasResponse (Maybe UTCTime)
describeBotAliasResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe POSIX
a -> DescribeBotAliasResponse
s {$sel:creationDateTime:DescribeBotAliasResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: DescribeBotAliasResponse) 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 description of the bot alias.
describeBotAliasResponse_description :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe Prelude.Text)
describeBotAliasResponse_description :: Lens' DescribeBotAliasResponse (Maybe Text)
describeBotAliasResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe Text
a -> DescribeBotAliasResponse
s {$sel:description:DescribeBotAliasResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeBotAliasResponse)

-- | A timestamp of the date and time that the alias was last updated.
describeBotAliasResponse_lastUpdatedDateTime :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe Prelude.UTCTime)
describeBotAliasResponse_lastUpdatedDateTime :: Lens' DescribeBotAliasResponse (Maybe UTCTime)
describeBotAliasResponse_lastUpdatedDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe POSIX
lastUpdatedDateTime :: Maybe POSIX
$sel:lastUpdatedDateTime:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe POSIX
lastUpdatedDateTime} -> Maybe POSIX
lastUpdatedDateTime) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe POSIX
a -> DescribeBotAliasResponse
s {$sel:lastUpdatedDateTime:DescribeBotAliasResponse' :: Maybe POSIX
lastUpdatedDateTime = Maybe POSIX
a} :: DescribeBotAliasResponse) 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

-- | Undocumented member.
describeBotAliasResponse_sentimentAnalysisSettings :: Lens.Lens' DescribeBotAliasResponse (Prelude.Maybe SentimentAnalysisSettings)
describeBotAliasResponse_sentimentAnalysisSettings :: Lens' DescribeBotAliasResponse (Maybe SentimentAnalysisSettings)
describeBotAliasResponse_sentimentAnalysisSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBotAliasResponse' {Maybe SentimentAnalysisSettings
sentimentAnalysisSettings :: Maybe SentimentAnalysisSettings
$sel:sentimentAnalysisSettings:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe SentimentAnalysisSettings
sentimentAnalysisSettings} -> Maybe SentimentAnalysisSettings
sentimentAnalysisSettings) (\s :: DescribeBotAliasResponse
s@DescribeBotAliasResponse' {} Maybe SentimentAnalysisSettings
a -> DescribeBotAliasResponse
s {$sel:sentimentAnalysisSettings:DescribeBotAliasResponse' :: Maybe SentimentAnalysisSettings
sentimentAnalysisSettings = Maybe SentimentAnalysisSettings
a} :: DescribeBotAliasResponse)

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

instance Prelude.NFData DescribeBotAliasResponse where
  rnf :: DescribeBotAliasResponse -> ()
rnf DescribeBotAliasResponse' {Int
Maybe [BotAliasHistoryEvent]
Maybe Text
Maybe (HashMap Text BotAliasLocaleSettings)
Maybe POSIX
Maybe BotAliasStatus
Maybe SentimentAnalysisSettings
Maybe ConversationLogSettings
httpStatus :: Int
sentimentAnalysisSettings :: Maybe SentimentAnalysisSettings
lastUpdatedDateTime :: Maybe POSIX
description :: Maybe Text
creationDateTime :: Maybe POSIX
conversationLogSettings :: Maybe ConversationLogSettings
botVersion :: Maybe Text
botId :: Maybe Text
botAliasStatus :: Maybe BotAliasStatus
botAliasName :: Maybe Text
botAliasLocaleSettings :: Maybe (HashMap Text BotAliasLocaleSettings)
botAliasId :: Maybe Text
botAliasHistoryEvents :: Maybe [BotAliasHistoryEvent]
$sel:httpStatus:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Int
$sel:sentimentAnalysisSettings:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe SentimentAnalysisSettings
$sel:lastUpdatedDateTime:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe POSIX
$sel:description:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
$sel:creationDateTime:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe POSIX
$sel:conversationLogSettings:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe ConversationLogSettings
$sel:botVersion:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
$sel:botId:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
$sel:botAliasStatus:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe BotAliasStatus
$sel:botAliasName:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
$sel:botAliasLocaleSettings:DescribeBotAliasResponse' :: DescribeBotAliasResponse
-> Maybe (HashMap Text BotAliasLocaleSettings)
$sel:botAliasId:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe Text
$sel:botAliasHistoryEvents:DescribeBotAliasResponse' :: DescribeBotAliasResponse -> Maybe [BotAliasHistoryEvent]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BotAliasHistoryEvent]
botAliasHistoryEvents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botAliasId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text BotAliasLocaleSettings)
botAliasLocaleSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botAliasName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BotAliasStatus
botAliasStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConversationLogSettings
conversationLogSettings
      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 POSIX
lastUpdatedDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SentimentAnalysisSettings
sentimentAnalysisSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus