{-# 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.Connect.DisassociateBot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This API is in preview release for Amazon Connect and is subject to
-- change.
--
-- Revokes authorization from the specified instance to access the
-- specified Amazon Lex or Amazon Lex V2 bot.
module Amazonka.Connect.DisassociateBot
  ( -- * Creating a Request
    DisassociateBot (..),
    newDisassociateBot,

    -- * Request Lenses
    disassociateBot_lexBot,
    disassociateBot_lexV2Bot,
    disassociateBot_instanceId,

    -- * Destructuring the Response
    DisassociateBotResponse (..),
    newDisassociateBotResponse,
  )
where

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

-- | /See:/ 'newDisassociateBot' smart constructor.
data DisassociateBot = DisassociateBot'
  { DisassociateBot -> Maybe LexBot
lexBot :: Prelude.Maybe LexBot,
    -- | The Amazon Lex V2 bot to disassociate from the instance.
    DisassociateBot -> Maybe LexV2Bot
lexV2Bot :: Prelude.Maybe LexV2Bot,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    DisassociateBot -> Text
instanceId :: Prelude.Text
  }
  deriving (DisassociateBot -> DisassociateBot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateBot -> DisassociateBot -> Bool
$c/= :: DisassociateBot -> DisassociateBot -> Bool
== :: DisassociateBot -> DisassociateBot -> Bool
$c== :: DisassociateBot -> DisassociateBot -> Bool
Prelude.Eq, ReadPrec [DisassociateBot]
ReadPrec DisassociateBot
Int -> ReadS DisassociateBot
ReadS [DisassociateBot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateBot]
$creadListPrec :: ReadPrec [DisassociateBot]
readPrec :: ReadPrec DisassociateBot
$creadPrec :: ReadPrec DisassociateBot
readList :: ReadS [DisassociateBot]
$creadList :: ReadS [DisassociateBot]
readsPrec :: Int -> ReadS DisassociateBot
$creadsPrec :: Int -> ReadS DisassociateBot
Prelude.Read, Int -> DisassociateBot -> ShowS
[DisassociateBot] -> ShowS
DisassociateBot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateBot] -> ShowS
$cshowList :: [DisassociateBot] -> ShowS
show :: DisassociateBot -> String
$cshow :: DisassociateBot -> String
showsPrec :: Int -> DisassociateBot -> ShowS
$cshowsPrec :: Int -> DisassociateBot -> ShowS
Prelude.Show, forall x. Rep DisassociateBot x -> DisassociateBot
forall x. DisassociateBot -> Rep DisassociateBot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisassociateBot x -> DisassociateBot
$cfrom :: forall x. DisassociateBot -> Rep DisassociateBot x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateBot' 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:
--
-- 'lexBot', 'disassociateBot_lexBot' - Undocumented member.
--
-- 'lexV2Bot', 'disassociateBot_lexV2Bot' - The Amazon Lex V2 bot to disassociate from the instance.
--
-- 'instanceId', 'disassociateBot_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
newDisassociateBot ::
  -- | 'instanceId'
  Prelude.Text ->
  DisassociateBot
newDisassociateBot :: Text -> DisassociateBot
newDisassociateBot Text
pInstanceId_ =
  DisassociateBot'
    { $sel:lexBot:DisassociateBot' :: Maybe LexBot
lexBot = forall a. Maybe a
Prelude.Nothing,
      $sel:lexV2Bot:DisassociateBot' :: Maybe LexV2Bot
lexV2Bot = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:DisassociateBot' :: Text
instanceId = Text
pInstanceId_
    }

-- | Undocumented member.
disassociateBot_lexBot :: Lens.Lens' DisassociateBot (Prelude.Maybe LexBot)
disassociateBot_lexBot :: Lens' DisassociateBot (Maybe LexBot)
disassociateBot_lexBot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateBot' {Maybe LexBot
lexBot :: Maybe LexBot
$sel:lexBot:DisassociateBot' :: DisassociateBot -> Maybe LexBot
lexBot} -> Maybe LexBot
lexBot) (\s :: DisassociateBot
s@DisassociateBot' {} Maybe LexBot
a -> DisassociateBot
s {$sel:lexBot:DisassociateBot' :: Maybe LexBot
lexBot = Maybe LexBot
a} :: DisassociateBot)

-- | The Amazon Lex V2 bot to disassociate from the instance.
disassociateBot_lexV2Bot :: Lens.Lens' DisassociateBot (Prelude.Maybe LexV2Bot)
disassociateBot_lexV2Bot :: Lens' DisassociateBot (Maybe LexV2Bot)
disassociateBot_lexV2Bot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateBot' {Maybe LexV2Bot
lexV2Bot :: Maybe LexV2Bot
$sel:lexV2Bot:DisassociateBot' :: DisassociateBot -> Maybe LexV2Bot
lexV2Bot} -> Maybe LexV2Bot
lexV2Bot) (\s :: DisassociateBot
s@DisassociateBot' {} Maybe LexV2Bot
a -> DisassociateBot
s {$sel:lexV2Bot:DisassociateBot' :: Maybe LexV2Bot
lexV2Bot = Maybe LexV2Bot
a} :: DisassociateBot)

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
disassociateBot_instanceId :: Lens.Lens' DisassociateBot Prelude.Text
disassociateBot_instanceId :: Lens' DisassociateBot Text
disassociateBot_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateBot' {Text
instanceId :: Text
$sel:instanceId:DisassociateBot' :: DisassociateBot -> Text
instanceId} -> Text
instanceId) (\s :: DisassociateBot
s@DisassociateBot' {} Text
a -> DisassociateBot
s {$sel:instanceId:DisassociateBot' :: Text
instanceId = Text
a} :: DisassociateBot)

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

instance Prelude.Hashable DisassociateBot where
  hashWithSalt :: Int -> DisassociateBot -> Int
hashWithSalt Int
_salt DisassociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:DisassociateBot' :: DisassociateBot -> Text
$sel:lexV2Bot:DisassociateBot' :: DisassociateBot -> Maybe LexV2Bot
$sel:lexBot:DisassociateBot' :: DisassociateBot -> Maybe LexBot
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LexBot
lexBot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LexV2Bot
lexV2Bot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData DisassociateBot where
  rnf :: DisassociateBot -> ()
rnf DisassociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:DisassociateBot' :: DisassociateBot -> Text
$sel:lexV2Bot:DisassociateBot' :: DisassociateBot -> Maybe LexV2Bot
$sel:lexBot:DisassociateBot' :: DisassociateBot -> Maybe LexBot
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LexBot
lexBot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LexV2Bot
lexV2Bot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders DisassociateBot where
  toHeaders :: DisassociateBot -> [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.ToJSON DisassociateBot where
  toJSON :: DisassociateBot -> Value
toJSON DisassociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:DisassociateBot' :: DisassociateBot -> Text
$sel:lexV2Bot:DisassociateBot' :: DisassociateBot -> Maybe LexV2Bot
$sel:lexBot:DisassociateBot' :: DisassociateBot -> Maybe LexBot
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"LexBot" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LexBot
lexBot,
            (Key
"LexV2Bot" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LexV2Bot
lexV2Bot
          ]
      )

instance Data.ToPath DisassociateBot where
  toPath :: DisassociateBot -> ByteString
toPath DisassociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:DisassociateBot' :: DisassociateBot -> Text
$sel:lexV2Bot:DisassociateBot' :: DisassociateBot -> Maybe LexV2Bot
$sel:lexBot:DisassociateBot' :: DisassociateBot -> Maybe LexBot
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/instance/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId, ByteString
"/bot"]

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

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

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

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