{-# 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.AssociateBot
-- 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.
--
-- Allows the specified Amazon Connect instance to access the specified
-- Amazon Lex or Amazon Lex V2 bot.
module Amazonka.Connect.AssociateBot
  ( -- * Creating a Request
    AssociateBot (..),
    newAssociateBot,

    -- * Request Lenses
    associateBot_lexBot,
    associateBot_lexV2Bot,
    associateBot_instanceId,

    -- * Destructuring the Response
    AssociateBotResponse (..),
    newAssociateBotResponse,
  )
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:/ 'newAssociateBot' smart constructor.
data AssociateBot = AssociateBot'
  { AssociateBot -> Maybe LexBot
lexBot :: Prelude.Maybe LexBot,
    -- | The Amazon Lex V2 bot to associate with the instance.
    AssociateBot -> Maybe LexV2Bot
lexV2Bot :: Prelude.Maybe LexV2Bot,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    AssociateBot -> Text
instanceId :: Prelude.Text
  }
  deriving (AssociateBot -> AssociateBot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateBot -> AssociateBot -> Bool
$c/= :: AssociateBot -> AssociateBot -> Bool
== :: AssociateBot -> AssociateBot -> Bool
$c== :: AssociateBot -> AssociateBot -> Bool
Prelude.Eq, ReadPrec [AssociateBot]
ReadPrec AssociateBot
Int -> ReadS AssociateBot
ReadS [AssociateBot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateBot]
$creadListPrec :: ReadPrec [AssociateBot]
readPrec :: ReadPrec AssociateBot
$creadPrec :: ReadPrec AssociateBot
readList :: ReadS [AssociateBot]
$creadList :: ReadS [AssociateBot]
readsPrec :: Int -> ReadS AssociateBot
$creadsPrec :: Int -> ReadS AssociateBot
Prelude.Read, Int -> AssociateBot -> ShowS
[AssociateBot] -> ShowS
AssociateBot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateBot] -> ShowS
$cshowList :: [AssociateBot] -> ShowS
show :: AssociateBot -> String
$cshow :: AssociateBot -> String
showsPrec :: Int -> AssociateBot -> ShowS
$cshowsPrec :: Int -> AssociateBot -> ShowS
Prelude.Show, forall x. Rep AssociateBot x -> AssociateBot
forall x. AssociateBot -> Rep AssociateBot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateBot x -> AssociateBot
$cfrom :: forall x. AssociateBot -> Rep AssociateBot x
Prelude.Generic)

-- |
-- Create a value of 'AssociateBot' 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', 'associateBot_lexBot' - Undocumented member.
--
-- 'lexV2Bot', 'associateBot_lexV2Bot' - The Amazon Lex V2 bot to associate with the instance.
--
-- 'instanceId', 'associateBot_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
newAssociateBot ::
  -- | 'instanceId'
  Prelude.Text ->
  AssociateBot
newAssociateBot :: Text -> AssociateBot
newAssociateBot Text
pInstanceId_ =
  AssociateBot'
    { $sel:lexBot:AssociateBot' :: Maybe LexBot
lexBot = forall a. Maybe a
Prelude.Nothing,
      $sel:lexV2Bot:AssociateBot' :: Maybe LexV2Bot
lexV2Bot = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:AssociateBot' :: Text
instanceId = Text
pInstanceId_
    }

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

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

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

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

instance Prelude.Hashable AssociateBot where
  hashWithSalt :: Int -> AssociateBot -> Int
hashWithSalt Int
_salt AssociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:AssociateBot' :: AssociateBot -> Text
$sel:lexV2Bot:AssociateBot' :: AssociateBot -> Maybe LexV2Bot
$sel:lexBot:AssociateBot' :: AssociateBot -> 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 AssociateBot where
  rnf :: AssociateBot -> ()
rnf AssociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:AssociateBot' :: AssociateBot -> Text
$sel:lexV2Bot:AssociateBot' :: AssociateBot -> Maybe LexV2Bot
$sel:lexBot:AssociateBot' :: AssociateBot -> 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 AssociateBot where
  toHeaders :: AssociateBot -> [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 AssociateBot where
  toJSON :: AssociateBot -> Value
toJSON AssociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:AssociateBot' :: AssociateBot -> Text
$sel:lexV2Bot:AssociateBot' :: AssociateBot -> Maybe LexV2Bot
$sel:lexBot:AssociateBot' :: AssociateBot -> 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 AssociateBot where
  toPath :: AssociateBot -> ByteString
toPath AssociateBot' {Maybe LexBot
Maybe LexV2Bot
Text
instanceId :: Text
lexV2Bot :: Maybe LexV2Bot
lexBot :: Maybe LexBot
$sel:instanceId:AssociateBot' :: AssociateBot -> Text
$sel:lexV2Bot:AssociateBot' :: AssociateBot -> Maybe LexV2Bot
$sel:lexBot:AssociateBot' :: AssociateBot -> 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 AssociateBot where
  toQuery :: AssociateBot -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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