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

    -- * Request Lenses
    deleteBotChannelAssociation_name,
    deleteBotChannelAssociation_botName,
    deleteBotChannelAssociation_botAlias,

    -- * Destructuring the Response
    DeleteBotChannelAssociationResponse (..),
    newDeleteBotChannelAssociationResponse,
  )
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:/ 'newDeleteBotChannelAssociation' smart constructor.
data DeleteBotChannelAssociation = DeleteBotChannelAssociation'
  { -- | The name of the association. The name is case sensitive.
    DeleteBotChannelAssociation -> Text
name :: Prelude.Text,
    -- | The name of the Amazon Lex bot.
    DeleteBotChannelAssociation -> Text
botName :: Prelude.Text,
    -- | An alias that points to the specific version of the Amazon Lex bot to
    -- which this association is being made.
    DeleteBotChannelAssociation -> Text
botAlias :: Prelude.Text
  }
  deriving (DeleteBotChannelAssociation -> DeleteBotChannelAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteBotChannelAssociation -> DeleteBotChannelAssociation -> Bool
$c/= :: DeleteBotChannelAssociation -> DeleteBotChannelAssociation -> Bool
== :: DeleteBotChannelAssociation -> DeleteBotChannelAssociation -> Bool
$c== :: DeleteBotChannelAssociation -> DeleteBotChannelAssociation -> Bool
Prelude.Eq, ReadPrec [DeleteBotChannelAssociation]
ReadPrec DeleteBotChannelAssociation
Int -> ReadS DeleteBotChannelAssociation
ReadS [DeleteBotChannelAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteBotChannelAssociation]
$creadListPrec :: ReadPrec [DeleteBotChannelAssociation]
readPrec :: ReadPrec DeleteBotChannelAssociation
$creadPrec :: ReadPrec DeleteBotChannelAssociation
readList :: ReadS [DeleteBotChannelAssociation]
$creadList :: ReadS [DeleteBotChannelAssociation]
readsPrec :: Int -> ReadS DeleteBotChannelAssociation
$creadsPrec :: Int -> ReadS DeleteBotChannelAssociation
Prelude.Read, Int -> DeleteBotChannelAssociation -> ShowS
[DeleteBotChannelAssociation] -> ShowS
DeleteBotChannelAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteBotChannelAssociation] -> ShowS
$cshowList :: [DeleteBotChannelAssociation] -> ShowS
show :: DeleteBotChannelAssociation -> String
$cshow :: DeleteBotChannelAssociation -> String
showsPrec :: Int -> DeleteBotChannelAssociation -> ShowS
$cshowsPrec :: Int -> DeleteBotChannelAssociation -> ShowS
Prelude.Show, forall x.
Rep DeleteBotChannelAssociation x -> DeleteBotChannelAssociation
forall x.
DeleteBotChannelAssociation -> Rep DeleteBotChannelAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteBotChannelAssociation x -> DeleteBotChannelAssociation
$cfrom :: forall x.
DeleteBotChannelAssociation -> Rep DeleteBotChannelAssociation x
Prelude.Generic)

-- |
-- Create a value of 'DeleteBotChannelAssociation' 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', 'deleteBotChannelAssociation_name' - The name of the association. The name is case sensitive.
--
-- 'botName', 'deleteBotChannelAssociation_botName' - The name of the Amazon Lex bot.
--
-- 'botAlias', 'deleteBotChannelAssociation_botAlias' - An alias that points to the specific version of the Amazon Lex bot to
-- which this association is being made.
newDeleteBotChannelAssociation ::
  -- | 'name'
  Prelude.Text ->
  -- | 'botName'
  Prelude.Text ->
  -- | 'botAlias'
  Prelude.Text ->
  DeleteBotChannelAssociation
newDeleteBotChannelAssociation :: Text -> Text -> Text -> DeleteBotChannelAssociation
newDeleteBotChannelAssociation
  Text
pName_
  Text
pBotName_
  Text
pBotAlias_ =
    DeleteBotChannelAssociation'
      { $sel:name:DeleteBotChannelAssociation' :: Text
name = Text
pName_,
        $sel:botName:DeleteBotChannelAssociation' :: Text
botName = Text
pBotName_,
        $sel:botAlias:DeleteBotChannelAssociation' :: Text
botAlias = Text
pBotAlias_
      }

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

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

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

instance Core.AWSRequest DeleteBotChannelAssociation where
  type
    AWSResponse DeleteBotChannelAssociation =
      DeleteBotChannelAssociationResponse
  request :: (Service -> Service)
-> DeleteBotChannelAssociation
-> Request DeleteBotChannelAssociation
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteBotChannelAssociation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteBotChannelAssociation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteBotChannelAssociationResponse
DeleteBotChannelAssociationResponse'

instance Prelude.Hashable DeleteBotChannelAssociation where
  hashWithSalt :: Int -> DeleteBotChannelAssociation -> Int
hashWithSalt Int
_salt DeleteBotChannelAssociation' {Text
botAlias :: Text
botName :: Text
name :: Text
$sel:botAlias:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> Text
$sel:botName:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> Text
$sel:name:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> 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 DeleteBotChannelAssociation where
  rnf :: DeleteBotChannelAssociation -> ()
rnf DeleteBotChannelAssociation' {Text
botAlias :: Text
botName :: Text
name :: Text
$sel:botAlias:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> Text
$sel:botName:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> Text
$sel:name:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> 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 DeleteBotChannelAssociation where
  toHeaders :: DeleteBotChannelAssociation -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteBotChannelAssociation where
  toPath :: DeleteBotChannelAssociation -> ByteString
toPath DeleteBotChannelAssociation' {Text
botAlias :: Text
botName :: Text
name :: Text
$sel:botAlias:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> Text
$sel:botName:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> Text
$sel:name:DeleteBotChannelAssociation' :: DeleteBotChannelAssociation -> 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 DeleteBotChannelAssociation where
  toQuery :: DeleteBotChannelAssociation -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDeleteBotChannelAssociationResponse' smart constructor.
data DeleteBotChannelAssociationResponse = DeleteBotChannelAssociationResponse'
  {
  }
  deriving (DeleteBotChannelAssociationResponse
-> DeleteBotChannelAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteBotChannelAssociationResponse
-> DeleteBotChannelAssociationResponse -> Bool
$c/= :: DeleteBotChannelAssociationResponse
-> DeleteBotChannelAssociationResponse -> Bool
== :: DeleteBotChannelAssociationResponse
-> DeleteBotChannelAssociationResponse -> Bool
$c== :: DeleteBotChannelAssociationResponse
-> DeleteBotChannelAssociationResponse -> Bool
Prelude.Eq, ReadPrec [DeleteBotChannelAssociationResponse]
ReadPrec DeleteBotChannelAssociationResponse
Int -> ReadS DeleteBotChannelAssociationResponse
ReadS [DeleteBotChannelAssociationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteBotChannelAssociationResponse]
$creadListPrec :: ReadPrec [DeleteBotChannelAssociationResponse]
readPrec :: ReadPrec DeleteBotChannelAssociationResponse
$creadPrec :: ReadPrec DeleteBotChannelAssociationResponse
readList :: ReadS [DeleteBotChannelAssociationResponse]
$creadList :: ReadS [DeleteBotChannelAssociationResponse]
readsPrec :: Int -> ReadS DeleteBotChannelAssociationResponse
$creadsPrec :: Int -> ReadS DeleteBotChannelAssociationResponse
Prelude.Read, Int -> DeleteBotChannelAssociationResponse -> ShowS
[DeleteBotChannelAssociationResponse] -> ShowS
DeleteBotChannelAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteBotChannelAssociationResponse] -> ShowS
$cshowList :: [DeleteBotChannelAssociationResponse] -> ShowS
show :: DeleteBotChannelAssociationResponse -> String
$cshow :: DeleteBotChannelAssociationResponse -> String
showsPrec :: Int -> DeleteBotChannelAssociationResponse -> ShowS
$cshowsPrec :: Int -> DeleteBotChannelAssociationResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteBotChannelAssociationResponse x
-> DeleteBotChannelAssociationResponse
forall x.
DeleteBotChannelAssociationResponse
-> Rep DeleteBotChannelAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteBotChannelAssociationResponse x
-> DeleteBotChannelAssociationResponse
$cfrom :: forall x.
DeleteBotChannelAssociationResponse
-> Rep DeleteBotChannelAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteBotChannelAssociationResponse' 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.
newDeleteBotChannelAssociationResponse ::
  DeleteBotChannelAssociationResponse
newDeleteBotChannelAssociationResponse :: DeleteBotChannelAssociationResponse
newDeleteBotChannelAssociationResponse =
  DeleteBotChannelAssociationResponse
DeleteBotChannelAssociationResponse'

instance
  Prelude.NFData
    DeleteBotChannelAssociationResponse
  where
  rnf :: DeleteBotChannelAssociationResponse -> ()
rnf DeleteBotChannelAssociationResponse
_ = ()