{-# 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.LexModels.GetBotChannelAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about the association between an Amazon Lex bot and
-- a messaging platform.
--
-- This operation requires permissions for the
-- @lex:GetBotChannelAssociation@ action.
module Amazonka.LexModels.GetBotChannelAssociation
  ( -- * Creating a Request
    GetBotChannelAssociation (..),
    newGetBotChannelAssociation,

    -- * Request Lenses
    getBotChannelAssociation_name,
    getBotChannelAssociation_botName,
    getBotChannelAssociation_botAlias,

    -- * Destructuring the Response
    GetBotChannelAssociationResponse (..),
    newGetBotChannelAssociationResponse,

    -- * Response Lenses
    getBotChannelAssociationResponse_botAlias,
    getBotChannelAssociationResponse_botConfiguration,
    getBotChannelAssociationResponse_botName,
    getBotChannelAssociationResponse_createdDate,
    getBotChannelAssociationResponse_description,
    getBotChannelAssociationResponse_failureReason,
    getBotChannelAssociationResponse_name,
    getBotChannelAssociationResponse_status,
    getBotChannelAssociationResponse_type,
    getBotChannelAssociationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetBotChannelAssociation' smart constructor.
data GetBotChannelAssociation = GetBotChannelAssociation'
  { -- | The name of the association between the bot and the channel. The name is
    -- case sensitive.
    GetBotChannelAssociation -> Text
name :: Prelude.Text,
    -- | The name of the Amazon Lex bot.
    GetBotChannelAssociation -> Text
botName :: Prelude.Text,
    -- | An alias pointing to the specific version of the Amazon Lex bot to which
    -- this association is being made.
    GetBotChannelAssociation -> Text
botAlias :: Prelude.Text
  }
  deriving (GetBotChannelAssociation -> GetBotChannelAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBotChannelAssociation -> GetBotChannelAssociation -> Bool
$c/= :: GetBotChannelAssociation -> GetBotChannelAssociation -> Bool
== :: GetBotChannelAssociation -> GetBotChannelAssociation -> Bool
$c== :: GetBotChannelAssociation -> GetBotChannelAssociation -> Bool
Prelude.Eq, ReadPrec [GetBotChannelAssociation]
ReadPrec GetBotChannelAssociation
Int -> ReadS GetBotChannelAssociation
ReadS [GetBotChannelAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBotChannelAssociation]
$creadListPrec :: ReadPrec [GetBotChannelAssociation]
readPrec :: ReadPrec GetBotChannelAssociation
$creadPrec :: ReadPrec GetBotChannelAssociation
readList :: ReadS [GetBotChannelAssociation]
$creadList :: ReadS [GetBotChannelAssociation]
readsPrec :: Int -> ReadS GetBotChannelAssociation
$creadsPrec :: Int -> ReadS GetBotChannelAssociation
Prelude.Read, Int -> GetBotChannelAssociation -> ShowS
[GetBotChannelAssociation] -> ShowS
GetBotChannelAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBotChannelAssociation] -> ShowS
$cshowList :: [GetBotChannelAssociation] -> ShowS
show :: GetBotChannelAssociation -> String
$cshow :: GetBotChannelAssociation -> String
showsPrec :: Int -> GetBotChannelAssociation -> ShowS
$cshowsPrec :: Int -> GetBotChannelAssociation -> ShowS
Prelude.Show, forall x.
Rep GetBotChannelAssociation x -> GetBotChannelAssociation
forall x.
GetBotChannelAssociation -> Rep GetBotChannelAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBotChannelAssociation x -> GetBotChannelAssociation
$cfrom :: forall x.
GetBotChannelAssociation -> Rep GetBotChannelAssociation x
Prelude.Generic)

-- |
-- Create a value of 'GetBotChannelAssociation' 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:
--
-- 'name', 'getBotChannelAssociation_name' - The name of the association between the bot and the channel. The name is
-- case sensitive.
--
-- 'botName', 'getBotChannelAssociation_botName' - The name of the Amazon Lex bot.
--
-- 'botAlias', 'getBotChannelAssociation_botAlias' - An alias pointing to the specific version of the Amazon Lex bot to which
-- this association is being made.
newGetBotChannelAssociation ::
  -- | 'name'
  Prelude.Text ->
  -- | 'botName'
  Prelude.Text ->
  -- | 'botAlias'
  Prelude.Text ->
  GetBotChannelAssociation
newGetBotChannelAssociation :: Text -> Text -> Text -> GetBotChannelAssociation
newGetBotChannelAssociation
  Text
pName_
  Text
pBotName_
  Text
pBotAlias_ =
    GetBotChannelAssociation'
      { $sel:name:GetBotChannelAssociation' :: Text
name = Text
pName_,
        $sel:botName:GetBotChannelAssociation' :: Text
botName = Text
pBotName_,
        $sel:botAlias:GetBotChannelAssociation' :: Text
botAlias = Text
pBotAlias_
      }

-- | The name of the association between the bot and the channel. The name is
-- case sensitive.
getBotChannelAssociation_name :: Lens.Lens' GetBotChannelAssociation Prelude.Text
getBotChannelAssociation_name :: Lens' GetBotChannelAssociation Text
getBotChannelAssociation_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociation' {Text
name :: Text
$sel:name:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
name} -> Text
name) (\s :: GetBotChannelAssociation
s@GetBotChannelAssociation' {} Text
a -> GetBotChannelAssociation
s {$sel:name:GetBotChannelAssociation' :: Text
name = Text
a} :: GetBotChannelAssociation)

-- | The name of the Amazon Lex bot.
getBotChannelAssociation_botName :: Lens.Lens' GetBotChannelAssociation Prelude.Text
getBotChannelAssociation_botName :: Lens' GetBotChannelAssociation Text
getBotChannelAssociation_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociation' {Text
botName :: Text
$sel:botName:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
botName} -> Text
botName) (\s :: GetBotChannelAssociation
s@GetBotChannelAssociation' {} Text
a -> GetBotChannelAssociation
s {$sel:botName:GetBotChannelAssociation' :: Text
botName = Text
a} :: GetBotChannelAssociation)

-- | An alias pointing to the specific version of the Amazon Lex bot to which
-- this association is being made.
getBotChannelAssociation_botAlias :: Lens.Lens' GetBotChannelAssociation Prelude.Text
getBotChannelAssociation_botAlias :: Lens' GetBotChannelAssociation Text
getBotChannelAssociation_botAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociation' {Text
botAlias :: Text
$sel:botAlias:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
botAlias} -> Text
botAlias) (\s :: GetBotChannelAssociation
s@GetBotChannelAssociation' {} Text
a -> GetBotChannelAssociation
s {$sel:botAlias:GetBotChannelAssociation' :: Text
botAlias = Text
a} :: GetBotChannelAssociation)

instance Core.AWSRequest GetBotChannelAssociation where
  type
    AWSResponse GetBotChannelAssociation =
      GetBotChannelAssociationResponse
  request :: (Service -> Service)
-> GetBotChannelAssociation -> Request GetBotChannelAssociation
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 GetBotChannelAssociation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBotChannelAssociation)))
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 (Sensitive (HashMap Text Text))
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ChannelStatus
-> Maybe ChannelType
-> Int
-> GetBotChannelAssociationResponse
GetBotChannelAssociationResponse'
            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
"botAlias")
            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
"botConfiguration"
                            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
"botName")
            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
"createdDate")
            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
"failureReason")
            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
"name")
            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
"status")
            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
"type")
            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 GetBotChannelAssociation where
  hashWithSalt :: Int -> GetBotChannelAssociation -> Int
hashWithSalt Int
_salt GetBotChannelAssociation' {Text
botAlias :: Text
botName :: Text
name :: Text
$sel:botAlias:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
$sel:botName:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
$sel:name:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botAlias

instance Prelude.NFData GetBotChannelAssociation where
  rnf :: GetBotChannelAssociation -> ()
rnf GetBotChannelAssociation' {Text
botAlias :: Text
botName :: Text
name :: Text
$sel:botAlias:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
$sel:botName:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
$sel:name:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botAlias

instance Data.ToHeaders GetBotChannelAssociation where
  toHeaders :: GetBotChannelAssociation -> 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 GetBotChannelAssociation where
  toPath :: GetBotChannelAssociation -> ByteString
toPath GetBotChannelAssociation' {Text
botAlias :: Text
botName :: Text
name :: Text
$sel:botAlias:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
$sel:botName:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
$sel:name:GetBotChannelAssociation' :: GetBotChannelAssociation -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botName,
        ByteString
"/aliases/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botAlias,
        ByteString
"/channels/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name
      ]

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

-- | /See:/ 'newGetBotChannelAssociationResponse' smart constructor.
data GetBotChannelAssociationResponse = GetBotChannelAssociationResponse'
  { -- | An alias pointing to the specific version of the Amazon Lex bot to which
    -- this association is being made.
    GetBotChannelAssociationResponse -> Maybe Text
botAlias :: Prelude.Maybe Prelude.Text,
    -- | Provides information that the messaging platform needs to communicate
    -- with the Amazon Lex bot.
    GetBotChannelAssociationResponse
-> Maybe (Sensitive (HashMap Text Text))
botConfiguration :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The name of the Amazon Lex bot.
    GetBotChannelAssociationResponse -> Maybe Text
botName :: Prelude.Maybe Prelude.Text,
    -- | The date that the association between the bot and the channel was
    -- created.
    GetBotChannelAssociationResponse -> Maybe POSIX
createdDate :: Prelude.Maybe Data.POSIX,
    -- | A description of the association between the bot and the channel.
    GetBotChannelAssociationResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | If @status@ is @FAILED@, Amazon Lex provides the reason that it failed
    -- to create the association.
    GetBotChannelAssociationResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | The name of the association between the bot and the channel.
    GetBotChannelAssociationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The status of the bot channel.
    --
    -- -   @CREATED@ - The channel has been created and is ready for use.
    --
    -- -   @IN_PROGRESS@ - Channel creation is in progress.
    --
    -- -   @FAILED@ - There was an error creating the channel. For information
    --     about the reason for the failure, see the @failureReason@ field.
    GetBotChannelAssociationResponse -> Maybe ChannelStatus
status :: Prelude.Maybe ChannelStatus,
    -- | The type of the messaging platform.
    GetBotChannelAssociationResponse -> Maybe ChannelType
type' :: Prelude.Maybe ChannelType,
    -- | The response's http status code.
    GetBotChannelAssociationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBotChannelAssociationResponse
-> GetBotChannelAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBotChannelAssociationResponse
-> GetBotChannelAssociationResponse -> Bool
$c/= :: GetBotChannelAssociationResponse
-> GetBotChannelAssociationResponse -> Bool
== :: GetBotChannelAssociationResponse
-> GetBotChannelAssociationResponse -> Bool
$c== :: GetBotChannelAssociationResponse
-> GetBotChannelAssociationResponse -> Bool
Prelude.Eq, Int -> GetBotChannelAssociationResponse -> ShowS
[GetBotChannelAssociationResponse] -> ShowS
GetBotChannelAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBotChannelAssociationResponse] -> ShowS
$cshowList :: [GetBotChannelAssociationResponse] -> ShowS
show :: GetBotChannelAssociationResponse -> String
$cshow :: GetBotChannelAssociationResponse -> String
showsPrec :: Int -> GetBotChannelAssociationResponse -> ShowS
$cshowsPrec :: Int -> GetBotChannelAssociationResponse -> ShowS
Prelude.Show, forall x.
Rep GetBotChannelAssociationResponse x
-> GetBotChannelAssociationResponse
forall x.
GetBotChannelAssociationResponse
-> Rep GetBotChannelAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBotChannelAssociationResponse x
-> GetBotChannelAssociationResponse
$cfrom :: forall x.
GetBotChannelAssociationResponse
-> Rep GetBotChannelAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBotChannelAssociationResponse' 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:
--
-- 'botAlias', 'getBotChannelAssociationResponse_botAlias' - An alias pointing to the specific version of the Amazon Lex bot to which
-- this association is being made.
--
-- 'botConfiguration', 'getBotChannelAssociationResponse_botConfiguration' - Provides information that the messaging platform needs to communicate
-- with the Amazon Lex bot.
--
-- 'botName', 'getBotChannelAssociationResponse_botName' - The name of the Amazon Lex bot.
--
-- 'createdDate', 'getBotChannelAssociationResponse_createdDate' - The date that the association between the bot and the channel was
-- created.
--
-- 'description', 'getBotChannelAssociationResponse_description' - A description of the association between the bot and the channel.
--
-- 'failureReason', 'getBotChannelAssociationResponse_failureReason' - If @status@ is @FAILED@, Amazon Lex provides the reason that it failed
-- to create the association.
--
-- 'name', 'getBotChannelAssociationResponse_name' - The name of the association between the bot and the channel.
--
-- 'status', 'getBotChannelAssociationResponse_status' - The status of the bot channel.
--
-- -   @CREATED@ - The channel has been created and is ready for use.
--
-- -   @IN_PROGRESS@ - Channel creation is in progress.
--
-- -   @FAILED@ - There was an error creating the channel. For information
--     about the reason for the failure, see the @failureReason@ field.
--
-- 'type'', 'getBotChannelAssociationResponse_type' - The type of the messaging platform.
--
-- 'httpStatus', 'getBotChannelAssociationResponse_httpStatus' - The response's http status code.
newGetBotChannelAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBotChannelAssociationResponse
newGetBotChannelAssociationResponse :: Int -> GetBotChannelAssociationResponse
newGetBotChannelAssociationResponse Int
pHttpStatus_ =
  GetBotChannelAssociationResponse'
    { $sel:botAlias:GetBotChannelAssociationResponse' :: Maybe Text
botAlias =
        forall a. Maybe a
Prelude.Nothing,
      $sel:botConfiguration:GetBotChannelAssociationResponse' :: Maybe (Sensitive (HashMap Text Text))
botConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:botName:GetBotChannelAssociationResponse' :: Maybe Text
botName = forall a. Maybe a
Prelude.Nothing,
      $sel:createdDate:GetBotChannelAssociationResponse' :: Maybe POSIX
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetBotChannelAssociationResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:GetBotChannelAssociationResponse' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetBotChannelAssociationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetBotChannelAssociationResponse' :: Maybe ChannelStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:type':GetBotChannelAssociationResponse' :: Maybe ChannelType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBotChannelAssociationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An alias pointing to the specific version of the Amazon Lex bot to which
-- this association is being made.
getBotChannelAssociationResponse_botAlias :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe Prelude.Text)
getBotChannelAssociationResponse_botAlias :: Lens' GetBotChannelAssociationResponse (Maybe Text)
getBotChannelAssociationResponse_botAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe Text
botAlias :: Maybe Text
$sel:botAlias:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
botAlias} -> Maybe Text
botAlias) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe Text
a -> GetBotChannelAssociationResponse
s {$sel:botAlias:GetBotChannelAssociationResponse' :: Maybe Text
botAlias = Maybe Text
a} :: GetBotChannelAssociationResponse)

-- | Provides information that the messaging platform needs to communicate
-- with the Amazon Lex bot.
getBotChannelAssociationResponse_botConfiguration :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getBotChannelAssociationResponse_botConfiguration :: Lens' GetBotChannelAssociationResponse (Maybe (HashMap Text Text))
getBotChannelAssociationResponse_botConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe (Sensitive (HashMap Text Text))
botConfiguration :: Maybe (Sensitive (HashMap Text Text))
$sel:botConfiguration:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse
-> Maybe (Sensitive (HashMap Text Text))
botConfiguration} -> Maybe (Sensitive (HashMap Text Text))
botConfiguration) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> GetBotChannelAssociationResponse
s {$sel:botConfiguration:GetBotChannelAssociationResponse' :: Maybe (Sensitive (HashMap Text Text))
botConfiguration = Maybe (Sensitive (HashMap Text Text))
a} :: GetBotChannelAssociationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | The name of the Amazon Lex bot.
getBotChannelAssociationResponse_botName :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe Prelude.Text)
getBotChannelAssociationResponse_botName :: Lens' GetBotChannelAssociationResponse (Maybe Text)
getBotChannelAssociationResponse_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe Text
botName :: Maybe Text
$sel:botName:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
botName} -> Maybe Text
botName) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe Text
a -> GetBotChannelAssociationResponse
s {$sel:botName:GetBotChannelAssociationResponse' :: Maybe Text
botName = Maybe Text
a} :: GetBotChannelAssociationResponse)

-- | The date that the association between the bot and the channel was
-- created.
getBotChannelAssociationResponse_createdDate :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe Prelude.UTCTime)
getBotChannelAssociationResponse_createdDate :: Lens' GetBotChannelAssociationResponse (Maybe UTCTime)
getBotChannelAssociationResponse_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe POSIX
createdDate :: Maybe POSIX
$sel:createdDate:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe POSIX
createdDate} -> Maybe POSIX
createdDate) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe POSIX
a -> GetBotChannelAssociationResponse
s {$sel:createdDate:GetBotChannelAssociationResponse' :: Maybe POSIX
createdDate = Maybe POSIX
a} :: GetBotChannelAssociationResponse) 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

-- | A description of the association between the bot and the channel.
getBotChannelAssociationResponse_description :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe Prelude.Text)
getBotChannelAssociationResponse_description :: Lens' GetBotChannelAssociationResponse (Maybe Text)
getBotChannelAssociationResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe Text
a -> GetBotChannelAssociationResponse
s {$sel:description:GetBotChannelAssociationResponse' :: Maybe Text
description = Maybe Text
a} :: GetBotChannelAssociationResponse)

-- | If @status@ is @FAILED@, Amazon Lex provides the reason that it failed
-- to create the association.
getBotChannelAssociationResponse_failureReason :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe Prelude.Text)
getBotChannelAssociationResponse_failureReason :: Lens' GetBotChannelAssociationResponse (Maybe Text)
getBotChannelAssociationResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe Text
a -> GetBotChannelAssociationResponse
s {$sel:failureReason:GetBotChannelAssociationResponse' :: Maybe Text
failureReason = Maybe Text
a} :: GetBotChannelAssociationResponse)

-- | The name of the association between the bot and the channel.
getBotChannelAssociationResponse_name :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe Prelude.Text)
getBotChannelAssociationResponse_name :: Lens' GetBotChannelAssociationResponse (Maybe Text)
getBotChannelAssociationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe Text
a -> GetBotChannelAssociationResponse
s {$sel:name:GetBotChannelAssociationResponse' :: Maybe Text
name = Maybe Text
a} :: GetBotChannelAssociationResponse)

-- | The status of the bot channel.
--
-- -   @CREATED@ - The channel has been created and is ready for use.
--
-- -   @IN_PROGRESS@ - Channel creation is in progress.
--
-- -   @FAILED@ - There was an error creating the channel. For information
--     about the reason for the failure, see the @failureReason@ field.
getBotChannelAssociationResponse_status :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe ChannelStatus)
getBotChannelAssociationResponse_status :: Lens' GetBotChannelAssociationResponse (Maybe ChannelStatus)
getBotChannelAssociationResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe ChannelStatus
status :: Maybe ChannelStatus
$sel:status:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe ChannelStatus
status} -> Maybe ChannelStatus
status) (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe ChannelStatus
a -> GetBotChannelAssociationResponse
s {$sel:status:GetBotChannelAssociationResponse' :: Maybe ChannelStatus
status = Maybe ChannelStatus
a} :: GetBotChannelAssociationResponse)

-- | The type of the messaging platform.
getBotChannelAssociationResponse_type :: Lens.Lens' GetBotChannelAssociationResponse (Prelude.Maybe ChannelType)
getBotChannelAssociationResponse_type :: Lens' GetBotChannelAssociationResponse (Maybe ChannelType)
getBotChannelAssociationResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBotChannelAssociationResponse' {Maybe ChannelType
type' :: Maybe ChannelType
$sel:type':GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe ChannelType
type'} -> Maybe ChannelType
type') (\s :: GetBotChannelAssociationResponse
s@GetBotChannelAssociationResponse' {} Maybe ChannelType
a -> GetBotChannelAssociationResponse
s {$sel:type':GetBotChannelAssociationResponse' :: Maybe ChannelType
type' = Maybe ChannelType
a} :: GetBotChannelAssociationResponse)

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

instance
  Prelude.NFData
    GetBotChannelAssociationResponse
  where
  rnf :: GetBotChannelAssociationResponse -> ()
rnf GetBotChannelAssociationResponse' {Int
Maybe Text
Maybe (Sensitive (HashMap Text Text))
Maybe POSIX
Maybe ChannelStatus
Maybe ChannelType
httpStatus :: Int
type' :: Maybe ChannelType
status :: Maybe ChannelStatus
name :: Maybe Text
failureReason :: Maybe Text
description :: Maybe Text
createdDate :: Maybe POSIX
botName :: Maybe Text
botConfiguration :: Maybe (Sensitive (HashMap Text Text))
botAlias :: Maybe Text
$sel:httpStatus:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Int
$sel:type':GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe ChannelType
$sel:status:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe ChannelStatus
$sel:name:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
$sel:failureReason:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
$sel:description:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
$sel:createdDate:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe POSIX
$sel:botName:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
$sel:botConfiguration:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse
-> Maybe (Sensitive (HashMap Text Text))
$sel:botAlias:GetBotChannelAssociationResponse' :: GetBotChannelAssociationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
botConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdDate
      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
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus