{-# 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.AssociateDefaultVocabulary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates an existing vocabulary as the default. Contact Lens for
-- Amazon Connect uses the vocabulary in post-call and real-time analysis
-- sessions for the given language.
module Amazonka.Connect.AssociateDefaultVocabulary
  ( -- * Creating a Request
    AssociateDefaultVocabulary (..),
    newAssociateDefaultVocabulary,

    -- * Request Lenses
    associateDefaultVocabulary_vocabularyId,
    associateDefaultVocabulary_instanceId,
    associateDefaultVocabulary_languageCode,

    -- * Destructuring the Response
    AssociateDefaultVocabularyResponse (..),
    newAssociateDefaultVocabularyResponse,

    -- * Response Lenses
    associateDefaultVocabularyResponse_httpStatus,
  )
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:/ 'newAssociateDefaultVocabulary' smart constructor.
data AssociateDefaultVocabulary = AssociateDefaultVocabulary'
  { -- | The identifier of the custom vocabulary. If this is empty, the default
    -- is set to none.
    AssociateDefaultVocabulary -> Maybe Text
vocabularyId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    AssociateDefaultVocabulary -> Text
instanceId :: Prelude.Text,
    -- | The language code of the vocabulary entries. For a list of languages and
    -- their corresponding language codes, see
    -- <https://docs.aws.amazon.com/transcribe/latest/dg/transcribe-whatis.html What is Amazon Transcribe?>
    AssociateDefaultVocabulary -> VocabularyLanguageCode
languageCode :: VocabularyLanguageCode
  }
  deriving (AssociateDefaultVocabulary -> AssociateDefaultVocabulary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateDefaultVocabulary -> AssociateDefaultVocabulary -> Bool
$c/= :: AssociateDefaultVocabulary -> AssociateDefaultVocabulary -> Bool
== :: AssociateDefaultVocabulary -> AssociateDefaultVocabulary -> Bool
$c== :: AssociateDefaultVocabulary -> AssociateDefaultVocabulary -> Bool
Prelude.Eq, ReadPrec [AssociateDefaultVocabulary]
ReadPrec AssociateDefaultVocabulary
Int -> ReadS AssociateDefaultVocabulary
ReadS [AssociateDefaultVocabulary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateDefaultVocabulary]
$creadListPrec :: ReadPrec [AssociateDefaultVocabulary]
readPrec :: ReadPrec AssociateDefaultVocabulary
$creadPrec :: ReadPrec AssociateDefaultVocabulary
readList :: ReadS [AssociateDefaultVocabulary]
$creadList :: ReadS [AssociateDefaultVocabulary]
readsPrec :: Int -> ReadS AssociateDefaultVocabulary
$creadsPrec :: Int -> ReadS AssociateDefaultVocabulary
Prelude.Read, Int -> AssociateDefaultVocabulary -> ShowS
[AssociateDefaultVocabulary] -> ShowS
AssociateDefaultVocabulary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateDefaultVocabulary] -> ShowS
$cshowList :: [AssociateDefaultVocabulary] -> ShowS
show :: AssociateDefaultVocabulary -> String
$cshow :: AssociateDefaultVocabulary -> String
showsPrec :: Int -> AssociateDefaultVocabulary -> ShowS
$cshowsPrec :: Int -> AssociateDefaultVocabulary -> ShowS
Prelude.Show, forall x.
Rep AssociateDefaultVocabulary x -> AssociateDefaultVocabulary
forall x.
AssociateDefaultVocabulary -> Rep AssociateDefaultVocabulary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateDefaultVocabulary x -> AssociateDefaultVocabulary
$cfrom :: forall x.
AssociateDefaultVocabulary -> Rep AssociateDefaultVocabulary x
Prelude.Generic)

-- |
-- Create a value of 'AssociateDefaultVocabulary' 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:
--
-- 'vocabularyId', 'associateDefaultVocabulary_vocabularyId' - The identifier of the custom vocabulary. If this is empty, the default
-- is set to none.
--
-- 'instanceId', 'associateDefaultVocabulary_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'languageCode', 'associateDefaultVocabulary_languageCode' - The language code of the vocabulary entries. For a list of languages and
-- their corresponding language codes, see
-- <https://docs.aws.amazon.com/transcribe/latest/dg/transcribe-whatis.html What is Amazon Transcribe?>
newAssociateDefaultVocabulary ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'languageCode'
  VocabularyLanguageCode ->
  AssociateDefaultVocabulary
newAssociateDefaultVocabulary :: Text -> VocabularyLanguageCode -> AssociateDefaultVocabulary
newAssociateDefaultVocabulary
  Text
pInstanceId_
  VocabularyLanguageCode
pLanguageCode_ =
    AssociateDefaultVocabulary'
      { $sel:vocabularyId:AssociateDefaultVocabulary' :: Maybe Text
vocabularyId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceId:AssociateDefaultVocabulary' :: Text
instanceId = Text
pInstanceId_,
        $sel:languageCode:AssociateDefaultVocabulary' :: VocabularyLanguageCode
languageCode = VocabularyLanguageCode
pLanguageCode_
      }

-- | The identifier of the custom vocabulary. If this is empty, the default
-- is set to none.
associateDefaultVocabulary_vocabularyId :: Lens.Lens' AssociateDefaultVocabulary (Prelude.Maybe Prelude.Text)
associateDefaultVocabulary_vocabularyId :: Lens' AssociateDefaultVocabulary (Maybe Text)
associateDefaultVocabulary_vocabularyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDefaultVocabulary' {Maybe Text
vocabularyId :: Maybe Text
$sel:vocabularyId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Maybe Text
vocabularyId} -> Maybe Text
vocabularyId) (\s :: AssociateDefaultVocabulary
s@AssociateDefaultVocabulary' {} Maybe Text
a -> AssociateDefaultVocabulary
s {$sel:vocabularyId:AssociateDefaultVocabulary' :: Maybe Text
vocabularyId = Maybe Text
a} :: AssociateDefaultVocabulary)

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

-- | The language code of the vocabulary entries. For a list of languages and
-- their corresponding language codes, see
-- <https://docs.aws.amazon.com/transcribe/latest/dg/transcribe-whatis.html What is Amazon Transcribe?>
associateDefaultVocabulary_languageCode :: Lens.Lens' AssociateDefaultVocabulary VocabularyLanguageCode
associateDefaultVocabulary_languageCode :: Lens' AssociateDefaultVocabulary VocabularyLanguageCode
associateDefaultVocabulary_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDefaultVocabulary' {VocabularyLanguageCode
languageCode :: VocabularyLanguageCode
$sel:languageCode:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> VocabularyLanguageCode
languageCode} -> VocabularyLanguageCode
languageCode) (\s :: AssociateDefaultVocabulary
s@AssociateDefaultVocabulary' {} VocabularyLanguageCode
a -> AssociateDefaultVocabulary
s {$sel:languageCode:AssociateDefaultVocabulary' :: VocabularyLanguageCode
languageCode = VocabularyLanguageCode
a} :: AssociateDefaultVocabulary)

instance Core.AWSRequest AssociateDefaultVocabulary where
  type
    AWSResponse AssociateDefaultVocabulary =
      AssociateDefaultVocabularyResponse
  request :: (Service -> Service)
-> AssociateDefaultVocabulary -> Request AssociateDefaultVocabulary
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 AssociateDefaultVocabulary
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateDefaultVocabulary)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociateDefaultVocabularyResponse
AssociateDefaultVocabularyResponse'
            forall (f :: * -> *) a b. Functor 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 AssociateDefaultVocabulary where
  hashWithSalt :: Int -> AssociateDefaultVocabulary -> Int
hashWithSalt Int
_salt AssociateDefaultVocabulary' {Maybe Text
Text
VocabularyLanguageCode
languageCode :: VocabularyLanguageCode
instanceId :: Text
vocabularyId :: Maybe Text
$sel:languageCode:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> VocabularyLanguageCode
$sel:instanceId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Text
$sel:vocabularyId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vocabularyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VocabularyLanguageCode
languageCode

instance Prelude.NFData AssociateDefaultVocabulary where
  rnf :: AssociateDefaultVocabulary -> ()
rnf AssociateDefaultVocabulary' {Maybe Text
Text
VocabularyLanguageCode
languageCode :: VocabularyLanguageCode
instanceId :: Text
vocabularyId :: Maybe Text
$sel:languageCode:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> VocabularyLanguageCode
$sel:instanceId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Text
$sel:vocabularyId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vocabularyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VocabularyLanguageCode
languageCode

instance Data.ToHeaders AssociateDefaultVocabulary where
  toHeaders :: AssociateDefaultVocabulary -> 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.ToJSON AssociateDefaultVocabulary where
  toJSON :: AssociateDefaultVocabulary -> Value
toJSON AssociateDefaultVocabulary' {Maybe Text
Text
VocabularyLanguageCode
languageCode :: VocabularyLanguageCode
instanceId :: Text
vocabularyId :: Maybe Text
$sel:languageCode:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> VocabularyLanguageCode
$sel:instanceId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Text
$sel:vocabularyId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"VocabularyId" 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 Text
vocabularyId]
      )

instance Data.ToPath AssociateDefaultVocabulary where
  toPath :: AssociateDefaultVocabulary -> ByteString
toPath AssociateDefaultVocabulary' {Maybe Text
Text
VocabularyLanguageCode
languageCode :: VocabularyLanguageCode
instanceId :: Text
vocabularyId :: Maybe Text
$sel:languageCode:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> VocabularyLanguageCode
$sel:instanceId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Text
$sel:vocabularyId:AssociateDefaultVocabulary' :: AssociateDefaultVocabulary -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/default-vocabulary/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS VocabularyLanguageCode
languageCode
      ]

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

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

-- |
-- Create a value of 'AssociateDefaultVocabularyResponse' 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:
--
-- 'httpStatus', 'associateDefaultVocabularyResponse_httpStatus' - The response's http status code.
newAssociateDefaultVocabularyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateDefaultVocabularyResponse
newAssociateDefaultVocabularyResponse :: Int -> AssociateDefaultVocabularyResponse
newAssociateDefaultVocabularyResponse Int
pHttpStatus_ =
  AssociateDefaultVocabularyResponse'
    { $sel:httpStatus:AssociateDefaultVocabularyResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    AssociateDefaultVocabularyResponse
  where
  rnf :: AssociateDefaultVocabularyResponse -> ()
rnf AssociateDefaultVocabularyResponse' {Int
httpStatus :: Int
$sel:httpStatus:AssociateDefaultVocabularyResponse' :: AssociateDefaultVocabularyResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus