{-# 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.LexV2Models.CreateIntent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an intent.
--
-- To define the interaction between the user and your bot, you define one
-- or more intents. For example, for a pizza ordering bot you would create
-- an @OrderPizza@ intent.
--
-- When you create an intent, you must provide a name. You can optionally
-- provide the following:
--
-- -   Sample utterances. For example, \"I want to order a pizza\" and
--     \"Can I order a pizza.\" You can\'t provide utterances for built-in
--     intents.
--
-- -   Information to be gathered. You specify slots for the information
--     that you bot requests from the user. You can specify standard slot
--     types, such as date and time, or custom slot types for your
--     application.
--
-- -   How the intent is fulfilled. You can provide a Lambda function or
--     configure the intent to return the intent information to your client
--     application. If you use a Lambda function, Amazon Lex invokes the
--     function when all of the intent information is available.
--
-- -   A confirmation prompt to send to the user to confirm an intent. For
--     example, \"Shall I order your pizza?\"
--
-- -   A conclusion statement to send to the user after the intent is
--     fulfilled. For example, \"I ordered your pizza.\"
--
-- -   A follow-up prompt that asks the user for additional activity. For
--     example, \"Do you want a drink with your pizza?\"
module Amazonka.LexV2Models.CreateIntent
  ( -- * Creating a Request
    CreateIntent (..),
    newCreateIntent,

    -- * Request Lenses
    createIntent_description,
    createIntent_dialogCodeHook,
    createIntent_fulfillmentCodeHook,
    createIntent_initialResponseSetting,
    createIntent_inputContexts,
    createIntent_intentClosingSetting,
    createIntent_intentConfirmationSetting,
    createIntent_kendraConfiguration,
    createIntent_outputContexts,
    createIntent_parentIntentSignature,
    createIntent_sampleUtterances,
    createIntent_intentName,
    createIntent_botId,
    createIntent_botVersion,
    createIntent_localeId,

    -- * Destructuring the Response
    CreateIntentResponse (..),
    newCreateIntentResponse,

    -- * Response Lenses
    createIntentResponse_botId,
    createIntentResponse_botVersion,
    createIntentResponse_creationDateTime,
    createIntentResponse_description,
    createIntentResponse_dialogCodeHook,
    createIntentResponse_fulfillmentCodeHook,
    createIntentResponse_initialResponseSetting,
    createIntentResponse_inputContexts,
    createIntentResponse_intentClosingSetting,
    createIntentResponse_intentConfirmationSetting,
    createIntentResponse_intentId,
    createIntentResponse_intentName,
    createIntentResponse_kendraConfiguration,
    createIntentResponse_localeId,
    createIntentResponse_outputContexts,
    createIntentResponse_parentIntentSignature,
    createIntentResponse_sampleUtterances,
    createIntentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateIntent' smart constructor.
data CreateIntent = CreateIntent'
  { -- | A description of the intent. Use the description to help identify the
    -- intent in lists.
    CreateIntent -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specifies that Amazon Lex invokes the alias Lambda function for each
    -- user input. You can invoke this Lambda function to personalize user
    -- interaction.
    --
    -- For example, suppose that your bot determines that the user\'s name is
    -- John. You Lambda function might retrieve John\'s information from a
    -- backend database and prepopulate some of the values. For example, if you
    -- find that John is gluten intolerant, you might set the corresponding
    -- intent slot, @glutenIntolerant@ to @true@. You might find John\'s phone
    -- number and set the corresponding session attribute.
    CreateIntent -> Maybe DialogCodeHookSettings
dialogCodeHook :: Prelude.Maybe DialogCodeHookSettings,
    -- | Specifies that Amazon Lex invokes the alias Lambda function when the
    -- intent is ready for fulfillment. You can invoke this function to
    -- complete the bot\'s transaction with the user.
    --
    -- For example, in a pizza ordering bot, the Lambda function can look up
    -- the closest pizza restaurant to the customer\'s location and then place
    -- an order on the customer\'s behalf.
    CreateIntent -> Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook :: Prelude.Maybe FulfillmentCodeHookSettings,
    -- | Configuration settings for the response that is sent to the user at the
    -- beginning of a conversation, before eliciting slot values.
    CreateIntent -> Maybe InitialResponseSetting
initialResponseSetting :: Prelude.Maybe InitialResponseSetting,
    -- | A list of contexts that must be active for this intent to be considered
    -- by Amazon Lex.
    --
    -- When an intent has an input context list, Amazon Lex only considers
    -- using the intent in an interaction with the user when the specified
    -- contexts are included in the active context list for the session. If the
    -- contexts are not active, then Amazon Lex will not use the intent.
    --
    -- A context can be automatically activated using the @outputContexts@
    -- property or it can be set at runtime.
    --
    -- For example, if there are two intents with different input contexts that
    -- respond to the same utterances, only the intent with the active context
    -- will respond.
    --
    -- An intent may have up to 5 input contexts. If an intent has multiple
    -- input contexts, all of the contexts must be active to consider the
    -- intent.
    CreateIntent -> Maybe [InputContext]
inputContexts :: Prelude.Maybe [InputContext],
    -- | Sets the response that Amazon Lex sends to the user when the intent is
    -- closed.
    CreateIntent -> Maybe IntentClosingSetting
intentClosingSetting :: Prelude.Maybe IntentClosingSetting,
    -- | Provides prompts that Amazon Lex sends to the user to confirm the
    -- completion of an intent. If the user answers \"no,\" the settings
    -- contain a statement that is sent to the user to end the intent.
    CreateIntent -> Maybe IntentConfirmationSetting
intentConfirmationSetting :: Prelude.Maybe IntentConfirmationSetting,
    -- | Configuration information required to use the
    -- @AMAZON.KendraSearchIntent@ intent to connect to an Amazon Kendra index.
    -- The @AMAZON.KendraSearchIntent@ intent is called when Amazon Lex can\'t
    -- determine another intent to invoke.
    CreateIntent -> Maybe KendraConfiguration
kendraConfiguration :: Prelude.Maybe KendraConfiguration,
    -- | A lists of contexts that the intent activates when it is fulfilled.
    --
    -- You can use an output context to indicate the intents that Amazon Lex
    -- should consider for the next turn of the conversation with a customer.
    --
    -- When you use the @outputContextsList@ property, all of the contexts
    -- specified in the list are activated when the intent is fulfilled. You
    -- can set up to 10 output contexts. You can also set the number of
    -- conversation turns that the context should be active, or the length of
    -- time that the context should be active.
    CreateIntent -> Maybe [OutputContext]
outputContexts :: Prelude.Maybe [OutputContext],
    -- | A unique identifier for the built-in intent to base this intent on.
    CreateIntent -> Maybe Text
parentIntentSignature :: Prelude.Maybe Prelude.Text,
    -- | An array of strings that a user might say to signal the intent. For
    -- example, \"I want a pizza\", or \"I want a {PizzaSize} pizza\".
    --
    -- In an utterance, slot names are enclosed in curly braces (\"{\", \"}\")
    -- to indicate where they should be displayed in the utterance shown to the
    -- user..
    CreateIntent -> Maybe [SampleUtterance]
sampleUtterances :: Prelude.Maybe [SampleUtterance],
    -- | The name of the intent. Intent names must be unique in the locale that
    -- contains the intent and cannot match the name of any built-in intent.
    CreateIntent -> Text
intentName :: Prelude.Text,
    -- | The identifier of the bot associated with this intent.
    CreateIntent -> Text
botId :: Prelude.Text,
    -- | The identifier of the version of the bot associated with this intent.
    CreateIntent -> Text
botVersion :: Prelude.Text,
    -- | The identifier of the language and locale where this intent is used. All
    -- of the bots, slot types, and slots used by the intent must have the same
    -- locale. For more information, see
    -- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
    CreateIntent -> Text
localeId :: Prelude.Text
  }
  deriving (CreateIntent -> CreateIntent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIntent -> CreateIntent -> Bool
$c/= :: CreateIntent -> CreateIntent -> Bool
== :: CreateIntent -> CreateIntent -> Bool
$c== :: CreateIntent -> CreateIntent -> Bool
Prelude.Eq, ReadPrec [CreateIntent]
ReadPrec CreateIntent
Int -> ReadS CreateIntent
ReadS [CreateIntent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIntent]
$creadListPrec :: ReadPrec [CreateIntent]
readPrec :: ReadPrec CreateIntent
$creadPrec :: ReadPrec CreateIntent
readList :: ReadS [CreateIntent]
$creadList :: ReadS [CreateIntent]
readsPrec :: Int -> ReadS CreateIntent
$creadsPrec :: Int -> ReadS CreateIntent
Prelude.Read, Int -> CreateIntent -> ShowS
[CreateIntent] -> ShowS
CreateIntent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIntent] -> ShowS
$cshowList :: [CreateIntent] -> ShowS
show :: CreateIntent -> String
$cshow :: CreateIntent -> String
showsPrec :: Int -> CreateIntent -> ShowS
$cshowsPrec :: Int -> CreateIntent -> ShowS
Prelude.Show, forall x. Rep CreateIntent x -> CreateIntent
forall x. CreateIntent -> Rep CreateIntent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIntent x -> CreateIntent
$cfrom :: forall x. CreateIntent -> Rep CreateIntent x
Prelude.Generic)

-- |
-- Create a value of 'CreateIntent' 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:
--
-- 'description', 'createIntent_description' - A description of the intent. Use the description to help identify the
-- intent in lists.
--
-- 'dialogCodeHook', 'createIntent_dialogCodeHook' - Specifies that Amazon Lex invokes the alias Lambda function for each
-- user input. You can invoke this Lambda function to personalize user
-- interaction.
--
-- For example, suppose that your bot determines that the user\'s name is
-- John. You Lambda function might retrieve John\'s information from a
-- backend database and prepopulate some of the values. For example, if you
-- find that John is gluten intolerant, you might set the corresponding
-- intent slot, @glutenIntolerant@ to @true@. You might find John\'s phone
-- number and set the corresponding session attribute.
--
-- 'fulfillmentCodeHook', 'createIntent_fulfillmentCodeHook' - Specifies that Amazon Lex invokes the alias Lambda function when the
-- intent is ready for fulfillment. You can invoke this function to
-- complete the bot\'s transaction with the user.
--
-- For example, in a pizza ordering bot, the Lambda function can look up
-- the closest pizza restaurant to the customer\'s location and then place
-- an order on the customer\'s behalf.
--
-- 'initialResponseSetting', 'createIntent_initialResponseSetting' - Configuration settings for the response that is sent to the user at the
-- beginning of a conversation, before eliciting slot values.
--
-- 'inputContexts', 'createIntent_inputContexts' - A list of contexts that must be active for this intent to be considered
-- by Amazon Lex.
--
-- When an intent has an input context list, Amazon Lex only considers
-- using the intent in an interaction with the user when the specified
-- contexts are included in the active context list for the session. If the
-- contexts are not active, then Amazon Lex will not use the intent.
--
-- A context can be automatically activated using the @outputContexts@
-- property or it can be set at runtime.
--
-- For example, if there are two intents with different input contexts that
-- respond to the same utterances, only the intent with the active context
-- will respond.
--
-- An intent may have up to 5 input contexts. If an intent has multiple
-- input contexts, all of the contexts must be active to consider the
-- intent.
--
-- 'intentClosingSetting', 'createIntent_intentClosingSetting' - Sets the response that Amazon Lex sends to the user when the intent is
-- closed.
--
-- 'intentConfirmationSetting', 'createIntent_intentConfirmationSetting' - Provides prompts that Amazon Lex sends to the user to confirm the
-- completion of an intent. If the user answers \"no,\" the settings
-- contain a statement that is sent to the user to end the intent.
--
-- 'kendraConfiguration', 'createIntent_kendraConfiguration' - Configuration information required to use the
-- @AMAZON.KendraSearchIntent@ intent to connect to an Amazon Kendra index.
-- The @AMAZON.KendraSearchIntent@ intent is called when Amazon Lex can\'t
-- determine another intent to invoke.
--
-- 'outputContexts', 'createIntent_outputContexts' - A lists of contexts that the intent activates when it is fulfilled.
--
-- You can use an output context to indicate the intents that Amazon Lex
-- should consider for the next turn of the conversation with a customer.
--
-- When you use the @outputContextsList@ property, all of the contexts
-- specified in the list are activated when the intent is fulfilled. You
-- can set up to 10 output contexts. You can also set the number of
-- conversation turns that the context should be active, or the length of
-- time that the context should be active.
--
-- 'parentIntentSignature', 'createIntent_parentIntentSignature' - A unique identifier for the built-in intent to base this intent on.
--
-- 'sampleUtterances', 'createIntent_sampleUtterances' - An array of strings that a user might say to signal the intent. For
-- example, \"I want a pizza\", or \"I want a {PizzaSize} pizza\".
--
-- In an utterance, slot names are enclosed in curly braces (\"{\", \"}\")
-- to indicate where they should be displayed in the utterance shown to the
-- user..
--
-- 'intentName', 'createIntent_intentName' - The name of the intent. Intent names must be unique in the locale that
-- contains the intent and cannot match the name of any built-in intent.
--
-- 'botId', 'createIntent_botId' - The identifier of the bot associated with this intent.
--
-- 'botVersion', 'createIntent_botVersion' - The identifier of the version of the bot associated with this intent.
--
-- 'localeId', 'createIntent_localeId' - The identifier of the language and locale where this intent is used. All
-- of the bots, slot types, and slots used by the intent must have the same
-- locale. For more information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
newCreateIntent ::
  -- | 'intentName'
  Prelude.Text ->
  -- | 'botId'
  Prelude.Text ->
  -- | 'botVersion'
  Prelude.Text ->
  -- | 'localeId'
  Prelude.Text ->
  CreateIntent
newCreateIntent :: Text -> Text -> Text -> Text -> CreateIntent
newCreateIntent
  Text
pIntentName_
  Text
pBotId_
  Text
pBotVersion_
  Text
pLocaleId_ =
    CreateIntent'
      { $sel:description:CreateIntent' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:dialogCodeHook:CreateIntent' :: Maybe DialogCodeHookSettings
dialogCodeHook = forall a. Maybe a
Prelude.Nothing,
        $sel:fulfillmentCodeHook:CreateIntent' :: Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook = forall a. Maybe a
Prelude.Nothing,
        $sel:initialResponseSetting:CreateIntent' :: Maybe InitialResponseSetting
initialResponseSetting = forall a. Maybe a
Prelude.Nothing,
        $sel:inputContexts:CreateIntent' :: Maybe [InputContext]
inputContexts = forall a. Maybe a
Prelude.Nothing,
        $sel:intentClosingSetting:CreateIntent' :: Maybe IntentClosingSetting
intentClosingSetting = forall a. Maybe a
Prelude.Nothing,
        $sel:intentConfirmationSetting:CreateIntent' :: Maybe IntentConfirmationSetting
intentConfirmationSetting = forall a. Maybe a
Prelude.Nothing,
        $sel:kendraConfiguration:CreateIntent' :: Maybe KendraConfiguration
kendraConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:outputContexts:CreateIntent' :: Maybe [OutputContext]
outputContexts = forall a. Maybe a
Prelude.Nothing,
        $sel:parentIntentSignature:CreateIntent' :: Maybe Text
parentIntentSignature = forall a. Maybe a
Prelude.Nothing,
        $sel:sampleUtterances:CreateIntent' :: Maybe [SampleUtterance]
sampleUtterances = forall a. Maybe a
Prelude.Nothing,
        $sel:intentName:CreateIntent' :: Text
intentName = Text
pIntentName_,
        $sel:botId:CreateIntent' :: Text
botId = Text
pBotId_,
        $sel:botVersion:CreateIntent' :: Text
botVersion = Text
pBotVersion_,
        $sel:localeId:CreateIntent' :: Text
localeId = Text
pLocaleId_
      }

-- | A description of the intent. Use the description to help identify the
-- intent in lists.
createIntent_description :: Lens.Lens' CreateIntent (Prelude.Maybe Prelude.Text)
createIntent_description :: Lens' CreateIntent (Maybe Text)
createIntent_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe Text
description :: Maybe Text
$sel:description:CreateIntent' :: CreateIntent -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateIntent
s@CreateIntent' {} Maybe Text
a -> CreateIntent
s {$sel:description:CreateIntent' :: Maybe Text
description = Maybe Text
a} :: CreateIntent)

-- | Specifies that Amazon Lex invokes the alias Lambda function for each
-- user input. You can invoke this Lambda function to personalize user
-- interaction.
--
-- For example, suppose that your bot determines that the user\'s name is
-- John. You Lambda function might retrieve John\'s information from a
-- backend database and prepopulate some of the values. For example, if you
-- find that John is gluten intolerant, you might set the corresponding
-- intent slot, @glutenIntolerant@ to @true@. You might find John\'s phone
-- number and set the corresponding session attribute.
createIntent_dialogCodeHook :: Lens.Lens' CreateIntent (Prelude.Maybe DialogCodeHookSettings)
createIntent_dialogCodeHook :: Lens' CreateIntent (Maybe DialogCodeHookSettings)
createIntent_dialogCodeHook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe DialogCodeHookSettings
dialogCodeHook :: Maybe DialogCodeHookSettings
$sel:dialogCodeHook:CreateIntent' :: CreateIntent -> Maybe DialogCodeHookSettings
dialogCodeHook} -> Maybe DialogCodeHookSettings
dialogCodeHook) (\s :: CreateIntent
s@CreateIntent' {} Maybe DialogCodeHookSettings
a -> CreateIntent
s {$sel:dialogCodeHook:CreateIntent' :: Maybe DialogCodeHookSettings
dialogCodeHook = Maybe DialogCodeHookSettings
a} :: CreateIntent)

-- | Specifies that Amazon Lex invokes the alias Lambda function when the
-- intent is ready for fulfillment. You can invoke this function to
-- complete the bot\'s transaction with the user.
--
-- For example, in a pizza ordering bot, the Lambda function can look up
-- the closest pizza restaurant to the customer\'s location and then place
-- an order on the customer\'s behalf.
createIntent_fulfillmentCodeHook :: Lens.Lens' CreateIntent (Prelude.Maybe FulfillmentCodeHookSettings)
createIntent_fulfillmentCodeHook :: Lens' CreateIntent (Maybe FulfillmentCodeHookSettings)
createIntent_fulfillmentCodeHook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook :: Maybe FulfillmentCodeHookSettings
$sel:fulfillmentCodeHook:CreateIntent' :: CreateIntent -> Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook} -> Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook) (\s :: CreateIntent
s@CreateIntent' {} Maybe FulfillmentCodeHookSettings
a -> CreateIntent
s {$sel:fulfillmentCodeHook:CreateIntent' :: Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook = Maybe FulfillmentCodeHookSettings
a} :: CreateIntent)

-- | Configuration settings for the response that is sent to the user at the
-- beginning of a conversation, before eliciting slot values.
createIntent_initialResponseSetting :: Lens.Lens' CreateIntent (Prelude.Maybe InitialResponseSetting)
createIntent_initialResponseSetting :: Lens' CreateIntent (Maybe InitialResponseSetting)
createIntent_initialResponseSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe InitialResponseSetting
initialResponseSetting :: Maybe InitialResponseSetting
$sel:initialResponseSetting:CreateIntent' :: CreateIntent -> Maybe InitialResponseSetting
initialResponseSetting} -> Maybe InitialResponseSetting
initialResponseSetting) (\s :: CreateIntent
s@CreateIntent' {} Maybe InitialResponseSetting
a -> CreateIntent
s {$sel:initialResponseSetting:CreateIntent' :: Maybe InitialResponseSetting
initialResponseSetting = Maybe InitialResponseSetting
a} :: CreateIntent)

-- | A list of contexts that must be active for this intent to be considered
-- by Amazon Lex.
--
-- When an intent has an input context list, Amazon Lex only considers
-- using the intent in an interaction with the user when the specified
-- contexts are included in the active context list for the session. If the
-- contexts are not active, then Amazon Lex will not use the intent.
--
-- A context can be automatically activated using the @outputContexts@
-- property or it can be set at runtime.
--
-- For example, if there are two intents with different input contexts that
-- respond to the same utterances, only the intent with the active context
-- will respond.
--
-- An intent may have up to 5 input contexts. If an intent has multiple
-- input contexts, all of the contexts must be active to consider the
-- intent.
createIntent_inputContexts :: Lens.Lens' CreateIntent (Prelude.Maybe [InputContext])
createIntent_inputContexts :: Lens' CreateIntent (Maybe [InputContext])
createIntent_inputContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe [InputContext]
inputContexts :: Maybe [InputContext]
$sel:inputContexts:CreateIntent' :: CreateIntent -> Maybe [InputContext]
inputContexts} -> Maybe [InputContext]
inputContexts) (\s :: CreateIntent
s@CreateIntent' {} Maybe [InputContext]
a -> CreateIntent
s {$sel:inputContexts:CreateIntent' :: Maybe [InputContext]
inputContexts = Maybe [InputContext]
a} :: CreateIntent) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Sets the response that Amazon Lex sends to the user when the intent is
-- closed.
createIntent_intentClosingSetting :: Lens.Lens' CreateIntent (Prelude.Maybe IntentClosingSetting)
createIntent_intentClosingSetting :: Lens' CreateIntent (Maybe IntentClosingSetting)
createIntent_intentClosingSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe IntentClosingSetting
intentClosingSetting :: Maybe IntentClosingSetting
$sel:intentClosingSetting:CreateIntent' :: CreateIntent -> Maybe IntentClosingSetting
intentClosingSetting} -> Maybe IntentClosingSetting
intentClosingSetting) (\s :: CreateIntent
s@CreateIntent' {} Maybe IntentClosingSetting
a -> CreateIntent
s {$sel:intentClosingSetting:CreateIntent' :: Maybe IntentClosingSetting
intentClosingSetting = Maybe IntentClosingSetting
a} :: CreateIntent)

-- | Provides prompts that Amazon Lex sends to the user to confirm the
-- completion of an intent. If the user answers \"no,\" the settings
-- contain a statement that is sent to the user to end the intent.
createIntent_intentConfirmationSetting :: Lens.Lens' CreateIntent (Prelude.Maybe IntentConfirmationSetting)
createIntent_intentConfirmationSetting :: Lens' CreateIntent (Maybe IntentConfirmationSetting)
createIntent_intentConfirmationSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe IntentConfirmationSetting
intentConfirmationSetting :: Maybe IntentConfirmationSetting
$sel:intentConfirmationSetting:CreateIntent' :: CreateIntent -> Maybe IntentConfirmationSetting
intentConfirmationSetting} -> Maybe IntentConfirmationSetting
intentConfirmationSetting) (\s :: CreateIntent
s@CreateIntent' {} Maybe IntentConfirmationSetting
a -> CreateIntent
s {$sel:intentConfirmationSetting:CreateIntent' :: Maybe IntentConfirmationSetting
intentConfirmationSetting = Maybe IntentConfirmationSetting
a} :: CreateIntent)

-- | Configuration information required to use the
-- @AMAZON.KendraSearchIntent@ intent to connect to an Amazon Kendra index.
-- The @AMAZON.KendraSearchIntent@ intent is called when Amazon Lex can\'t
-- determine another intent to invoke.
createIntent_kendraConfiguration :: Lens.Lens' CreateIntent (Prelude.Maybe KendraConfiguration)
createIntent_kendraConfiguration :: Lens' CreateIntent (Maybe KendraConfiguration)
createIntent_kendraConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe KendraConfiguration
kendraConfiguration :: Maybe KendraConfiguration
$sel:kendraConfiguration:CreateIntent' :: CreateIntent -> Maybe KendraConfiguration
kendraConfiguration} -> Maybe KendraConfiguration
kendraConfiguration) (\s :: CreateIntent
s@CreateIntent' {} Maybe KendraConfiguration
a -> CreateIntent
s {$sel:kendraConfiguration:CreateIntent' :: Maybe KendraConfiguration
kendraConfiguration = Maybe KendraConfiguration
a} :: CreateIntent)

-- | A lists of contexts that the intent activates when it is fulfilled.
--
-- You can use an output context to indicate the intents that Amazon Lex
-- should consider for the next turn of the conversation with a customer.
--
-- When you use the @outputContextsList@ property, all of the contexts
-- specified in the list are activated when the intent is fulfilled. You
-- can set up to 10 output contexts. You can also set the number of
-- conversation turns that the context should be active, or the length of
-- time that the context should be active.
createIntent_outputContexts :: Lens.Lens' CreateIntent (Prelude.Maybe [OutputContext])
createIntent_outputContexts :: Lens' CreateIntent (Maybe [OutputContext])
createIntent_outputContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe [OutputContext]
outputContexts :: Maybe [OutputContext]
$sel:outputContexts:CreateIntent' :: CreateIntent -> Maybe [OutputContext]
outputContexts} -> Maybe [OutputContext]
outputContexts) (\s :: CreateIntent
s@CreateIntent' {} Maybe [OutputContext]
a -> CreateIntent
s {$sel:outputContexts:CreateIntent' :: Maybe [OutputContext]
outputContexts = Maybe [OutputContext]
a} :: CreateIntent) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A unique identifier for the built-in intent to base this intent on.
createIntent_parentIntentSignature :: Lens.Lens' CreateIntent (Prelude.Maybe Prelude.Text)
createIntent_parentIntentSignature :: Lens' CreateIntent (Maybe Text)
createIntent_parentIntentSignature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe Text
parentIntentSignature :: Maybe Text
$sel:parentIntentSignature:CreateIntent' :: CreateIntent -> Maybe Text
parentIntentSignature} -> Maybe Text
parentIntentSignature) (\s :: CreateIntent
s@CreateIntent' {} Maybe Text
a -> CreateIntent
s {$sel:parentIntentSignature:CreateIntent' :: Maybe Text
parentIntentSignature = Maybe Text
a} :: CreateIntent)

-- | An array of strings that a user might say to signal the intent. For
-- example, \"I want a pizza\", or \"I want a {PizzaSize} pizza\".
--
-- In an utterance, slot names are enclosed in curly braces (\"{\", \"}\")
-- to indicate where they should be displayed in the utterance shown to the
-- user..
createIntent_sampleUtterances :: Lens.Lens' CreateIntent (Prelude.Maybe [SampleUtterance])
createIntent_sampleUtterances :: Lens' CreateIntent (Maybe [SampleUtterance])
createIntent_sampleUtterances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Maybe [SampleUtterance]
sampleUtterances :: Maybe [SampleUtterance]
$sel:sampleUtterances:CreateIntent' :: CreateIntent -> Maybe [SampleUtterance]
sampleUtterances} -> Maybe [SampleUtterance]
sampleUtterances) (\s :: CreateIntent
s@CreateIntent' {} Maybe [SampleUtterance]
a -> CreateIntent
s {$sel:sampleUtterances:CreateIntent' :: Maybe [SampleUtterance]
sampleUtterances = Maybe [SampleUtterance]
a} :: CreateIntent) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the intent. Intent names must be unique in the locale that
-- contains the intent and cannot match the name of any built-in intent.
createIntent_intentName :: Lens.Lens' CreateIntent Prelude.Text
createIntent_intentName :: Lens' CreateIntent Text
createIntent_intentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Text
intentName :: Text
$sel:intentName:CreateIntent' :: CreateIntent -> Text
intentName} -> Text
intentName) (\s :: CreateIntent
s@CreateIntent' {} Text
a -> CreateIntent
s {$sel:intentName:CreateIntent' :: Text
intentName = Text
a} :: CreateIntent)

-- | The identifier of the bot associated with this intent.
createIntent_botId :: Lens.Lens' CreateIntent Prelude.Text
createIntent_botId :: Lens' CreateIntent Text
createIntent_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Text
botId :: Text
$sel:botId:CreateIntent' :: CreateIntent -> Text
botId} -> Text
botId) (\s :: CreateIntent
s@CreateIntent' {} Text
a -> CreateIntent
s {$sel:botId:CreateIntent' :: Text
botId = Text
a} :: CreateIntent)

-- | The identifier of the version of the bot associated with this intent.
createIntent_botVersion :: Lens.Lens' CreateIntent Prelude.Text
createIntent_botVersion :: Lens' CreateIntent Text
createIntent_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Text
botVersion :: Text
$sel:botVersion:CreateIntent' :: CreateIntent -> Text
botVersion} -> Text
botVersion) (\s :: CreateIntent
s@CreateIntent' {} Text
a -> CreateIntent
s {$sel:botVersion:CreateIntent' :: Text
botVersion = Text
a} :: CreateIntent)

-- | The identifier of the language and locale where this intent is used. All
-- of the bots, slot types, and slots used by the intent must have the same
-- locale. For more information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
createIntent_localeId :: Lens.Lens' CreateIntent Prelude.Text
createIntent_localeId :: Lens' CreateIntent Text
createIntent_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntent' {Text
localeId :: Text
$sel:localeId:CreateIntent' :: CreateIntent -> Text
localeId} -> Text
localeId) (\s :: CreateIntent
s@CreateIntent' {} Text
a -> CreateIntent
s {$sel:localeId:CreateIntent' :: Text
localeId = Text
a} :: CreateIntent)

instance Core.AWSRequest CreateIntent where
  type AWSResponse CreateIntent = CreateIntentResponse
  request :: (Service -> Service) -> CreateIntent -> Request CreateIntent
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 CreateIntent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateIntent)))
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 Text
-> Maybe POSIX
-> Maybe Text
-> Maybe DialogCodeHookSettings
-> Maybe FulfillmentCodeHookSettings
-> Maybe InitialResponseSetting
-> Maybe [InputContext]
-> Maybe IntentClosingSetting
-> Maybe IntentConfirmationSetting
-> Maybe Text
-> Maybe Text
-> Maybe KendraConfiguration
-> Maybe Text
-> Maybe [OutputContext]
-> Maybe Text
-> Maybe [SampleUtterance]
-> Int
-> CreateIntentResponse
CreateIntentResponse'
            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
"botId")
            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
"botVersion")
            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
"creationDateTime")
            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
"dialogCodeHook")
            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
"fulfillmentCodeHook")
            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
"initialResponseSetting")
            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
"inputContexts" 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
"intentClosingSetting")
            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
"intentConfirmationSetting")
            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
"intentId")
            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
"intentName")
            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
"kendraConfiguration")
            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
"localeId")
            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
"outputContexts" 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
"parentIntentSignature")
            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
"sampleUtterances"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateIntent where
  hashWithSalt :: Int -> CreateIntent -> Int
hashWithSalt Int
_salt CreateIntent' {Maybe [InputContext]
Maybe [OutputContext]
Maybe [SampleUtterance]
Maybe Text
Maybe DialogCodeHookSettings
Maybe KendraConfiguration
Maybe FulfillmentCodeHookSettings
Maybe IntentClosingSetting
Maybe InitialResponseSetting
Maybe IntentConfirmationSetting
Text
localeId :: Text
botVersion :: Text
botId :: Text
intentName :: Text
sampleUtterances :: Maybe [SampleUtterance]
parentIntentSignature :: Maybe Text
outputContexts :: Maybe [OutputContext]
kendraConfiguration :: Maybe KendraConfiguration
intentConfirmationSetting :: Maybe IntentConfirmationSetting
intentClosingSetting :: Maybe IntentClosingSetting
inputContexts :: Maybe [InputContext]
initialResponseSetting :: Maybe InitialResponseSetting
fulfillmentCodeHook :: Maybe FulfillmentCodeHookSettings
dialogCodeHook :: Maybe DialogCodeHookSettings
description :: Maybe Text
$sel:localeId:CreateIntent' :: CreateIntent -> Text
$sel:botVersion:CreateIntent' :: CreateIntent -> Text
$sel:botId:CreateIntent' :: CreateIntent -> Text
$sel:intentName:CreateIntent' :: CreateIntent -> Text
$sel:sampleUtterances:CreateIntent' :: CreateIntent -> Maybe [SampleUtterance]
$sel:parentIntentSignature:CreateIntent' :: CreateIntent -> Maybe Text
$sel:outputContexts:CreateIntent' :: CreateIntent -> Maybe [OutputContext]
$sel:kendraConfiguration:CreateIntent' :: CreateIntent -> Maybe KendraConfiguration
$sel:intentConfirmationSetting:CreateIntent' :: CreateIntent -> Maybe IntentConfirmationSetting
$sel:intentClosingSetting:CreateIntent' :: CreateIntent -> Maybe IntentClosingSetting
$sel:inputContexts:CreateIntent' :: CreateIntent -> Maybe [InputContext]
$sel:initialResponseSetting:CreateIntent' :: CreateIntent -> Maybe InitialResponseSetting
$sel:fulfillmentCodeHook:CreateIntent' :: CreateIntent -> Maybe FulfillmentCodeHookSettings
$sel:dialogCodeHook:CreateIntent' :: CreateIntent -> Maybe DialogCodeHookSettings
$sel:description:CreateIntent' :: CreateIntent -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DialogCodeHookSettings
dialogCodeHook
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InitialResponseSetting
initialResponseSetting
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputContext]
inputContexts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IntentClosingSetting
intentClosingSetting
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IntentConfirmationSetting
intentConfirmationSetting
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KendraConfiguration
kendraConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [OutputContext]
outputContexts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parentIntentSignature
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SampleUtterance]
sampleUtterances
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
intentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
localeId

instance Prelude.NFData CreateIntent where
  rnf :: CreateIntent -> ()
rnf CreateIntent' {Maybe [InputContext]
Maybe [OutputContext]
Maybe [SampleUtterance]
Maybe Text
Maybe DialogCodeHookSettings
Maybe KendraConfiguration
Maybe FulfillmentCodeHookSettings
Maybe IntentClosingSetting
Maybe InitialResponseSetting
Maybe IntentConfirmationSetting
Text
localeId :: Text
botVersion :: Text
botId :: Text
intentName :: Text
sampleUtterances :: Maybe [SampleUtterance]
parentIntentSignature :: Maybe Text
outputContexts :: Maybe [OutputContext]
kendraConfiguration :: Maybe KendraConfiguration
intentConfirmationSetting :: Maybe IntentConfirmationSetting
intentClosingSetting :: Maybe IntentClosingSetting
inputContexts :: Maybe [InputContext]
initialResponseSetting :: Maybe InitialResponseSetting
fulfillmentCodeHook :: Maybe FulfillmentCodeHookSettings
dialogCodeHook :: Maybe DialogCodeHookSettings
description :: Maybe Text
$sel:localeId:CreateIntent' :: CreateIntent -> Text
$sel:botVersion:CreateIntent' :: CreateIntent -> Text
$sel:botId:CreateIntent' :: CreateIntent -> Text
$sel:intentName:CreateIntent' :: CreateIntent -> Text
$sel:sampleUtterances:CreateIntent' :: CreateIntent -> Maybe [SampleUtterance]
$sel:parentIntentSignature:CreateIntent' :: CreateIntent -> Maybe Text
$sel:outputContexts:CreateIntent' :: CreateIntent -> Maybe [OutputContext]
$sel:kendraConfiguration:CreateIntent' :: CreateIntent -> Maybe KendraConfiguration
$sel:intentConfirmationSetting:CreateIntent' :: CreateIntent -> Maybe IntentConfirmationSetting
$sel:intentClosingSetting:CreateIntent' :: CreateIntent -> Maybe IntentClosingSetting
$sel:inputContexts:CreateIntent' :: CreateIntent -> Maybe [InputContext]
$sel:initialResponseSetting:CreateIntent' :: CreateIntent -> Maybe InitialResponseSetting
$sel:fulfillmentCodeHook:CreateIntent' :: CreateIntent -> Maybe FulfillmentCodeHookSettings
$sel:dialogCodeHook:CreateIntent' :: CreateIntent -> Maybe DialogCodeHookSettings
$sel:description:CreateIntent' :: CreateIntent -> Maybe Text
..} =
    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 DialogCodeHookSettings
dialogCodeHook
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InitialResponseSetting
initialResponseSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputContext]
inputContexts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IntentClosingSetting
intentClosingSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IntentConfirmationSetting
intentConfirmationSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KendraConfiguration
kendraConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OutputContext]
outputContexts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentIntentSignature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SampleUtterance]
sampleUtterances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
intentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
localeId

instance Data.ToHeaders CreateIntent where
  toHeaders :: CreateIntent -> 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 CreateIntent where
  toJSON :: CreateIntent -> Value
toJSON CreateIntent' {Maybe [InputContext]
Maybe [OutputContext]
Maybe [SampleUtterance]
Maybe Text
Maybe DialogCodeHookSettings
Maybe KendraConfiguration
Maybe FulfillmentCodeHookSettings
Maybe IntentClosingSetting
Maybe InitialResponseSetting
Maybe IntentConfirmationSetting
Text
localeId :: Text
botVersion :: Text
botId :: Text
intentName :: Text
sampleUtterances :: Maybe [SampleUtterance]
parentIntentSignature :: Maybe Text
outputContexts :: Maybe [OutputContext]
kendraConfiguration :: Maybe KendraConfiguration
intentConfirmationSetting :: Maybe IntentConfirmationSetting
intentClosingSetting :: Maybe IntentClosingSetting
inputContexts :: Maybe [InputContext]
initialResponseSetting :: Maybe InitialResponseSetting
fulfillmentCodeHook :: Maybe FulfillmentCodeHookSettings
dialogCodeHook :: Maybe DialogCodeHookSettings
description :: Maybe Text
$sel:localeId:CreateIntent' :: CreateIntent -> Text
$sel:botVersion:CreateIntent' :: CreateIntent -> Text
$sel:botId:CreateIntent' :: CreateIntent -> Text
$sel:intentName:CreateIntent' :: CreateIntent -> Text
$sel:sampleUtterances:CreateIntent' :: CreateIntent -> Maybe [SampleUtterance]
$sel:parentIntentSignature:CreateIntent' :: CreateIntent -> Maybe Text
$sel:outputContexts:CreateIntent' :: CreateIntent -> Maybe [OutputContext]
$sel:kendraConfiguration:CreateIntent' :: CreateIntent -> Maybe KendraConfiguration
$sel:intentConfirmationSetting:CreateIntent' :: CreateIntent -> Maybe IntentConfirmationSetting
$sel:intentClosingSetting:CreateIntent' :: CreateIntent -> Maybe IntentClosingSetting
$sel:inputContexts:CreateIntent' :: CreateIntent -> Maybe [InputContext]
$sel:initialResponseSetting:CreateIntent' :: CreateIntent -> Maybe InitialResponseSetting
$sel:fulfillmentCodeHook:CreateIntent' :: CreateIntent -> Maybe FulfillmentCodeHookSettings
$sel:dialogCodeHook:CreateIntent' :: CreateIntent -> Maybe DialogCodeHookSettings
$sel:description:CreateIntent' :: CreateIntent -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" 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
description,
            (Key
"dialogCodeHook" 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 DialogCodeHookSettings
dialogCodeHook,
            (Key
"fulfillmentCodeHook" 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 FulfillmentCodeHookSettings
fulfillmentCodeHook,
            (Key
"initialResponseSetting" 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 InitialResponseSetting
initialResponseSetting,
            (Key
"inputContexts" 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 [InputContext]
inputContexts,
            (Key
"intentClosingSetting" 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 IntentClosingSetting
intentClosingSetting,
            (Key
"intentConfirmationSetting" 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 IntentConfirmationSetting
intentConfirmationSetting,
            (Key
"kendraConfiguration" 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 KendraConfiguration
kendraConfiguration,
            (Key
"outputContexts" 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 [OutputContext]
outputContexts,
            (Key
"parentIntentSignature" 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
parentIntentSignature,
            (Key
"sampleUtterances" 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 [SampleUtterance]
sampleUtterances,
            forall a. a -> Maybe a
Prelude.Just (Key
"intentName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
intentName)
          ]
      )

instance Data.ToPath CreateIntent where
  toPath :: CreateIntent -> ByteString
toPath CreateIntent' {Maybe [InputContext]
Maybe [OutputContext]
Maybe [SampleUtterance]
Maybe Text
Maybe DialogCodeHookSettings
Maybe KendraConfiguration
Maybe FulfillmentCodeHookSettings
Maybe IntentClosingSetting
Maybe InitialResponseSetting
Maybe IntentConfirmationSetting
Text
localeId :: Text
botVersion :: Text
botId :: Text
intentName :: Text
sampleUtterances :: Maybe [SampleUtterance]
parentIntentSignature :: Maybe Text
outputContexts :: Maybe [OutputContext]
kendraConfiguration :: Maybe KendraConfiguration
intentConfirmationSetting :: Maybe IntentConfirmationSetting
intentClosingSetting :: Maybe IntentClosingSetting
inputContexts :: Maybe [InputContext]
initialResponseSetting :: Maybe InitialResponseSetting
fulfillmentCodeHook :: Maybe FulfillmentCodeHookSettings
dialogCodeHook :: Maybe DialogCodeHookSettings
description :: Maybe Text
$sel:localeId:CreateIntent' :: CreateIntent -> Text
$sel:botVersion:CreateIntent' :: CreateIntent -> Text
$sel:botId:CreateIntent' :: CreateIntent -> Text
$sel:intentName:CreateIntent' :: CreateIntent -> Text
$sel:sampleUtterances:CreateIntent' :: CreateIntent -> Maybe [SampleUtterance]
$sel:parentIntentSignature:CreateIntent' :: CreateIntent -> Maybe Text
$sel:outputContexts:CreateIntent' :: CreateIntent -> Maybe [OutputContext]
$sel:kendraConfiguration:CreateIntent' :: CreateIntent -> Maybe KendraConfiguration
$sel:intentConfirmationSetting:CreateIntent' :: CreateIntent -> Maybe IntentConfirmationSetting
$sel:intentClosingSetting:CreateIntent' :: CreateIntent -> Maybe IntentClosingSetting
$sel:inputContexts:CreateIntent' :: CreateIntent -> Maybe [InputContext]
$sel:initialResponseSetting:CreateIntent' :: CreateIntent -> Maybe InitialResponseSetting
$sel:fulfillmentCodeHook:CreateIntent' :: CreateIntent -> Maybe FulfillmentCodeHookSettings
$sel:dialogCodeHook:CreateIntent' :: CreateIntent -> Maybe DialogCodeHookSettings
$sel:description:CreateIntent' :: CreateIntent -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botId,
        ByteString
"/botversions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botVersion,
        ByteString
"/botlocales/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
localeId,
        ByteString
"/intents/"
      ]

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

-- | /See:/ 'newCreateIntentResponse' smart constructor.
data CreateIntentResponse = CreateIntentResponse'
  { -- | The identifier of the bot associated with the intent.
    CreateIntentResponse -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the version of the bot associated with the intent.
    CreateIntentResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | A timestamp of the date and time that the intent was created.
    CreateIntentResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The description specified for the intent.
    CreateIntentResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The dialog Lambda function specified for the intent.
    CreateIntentResponse -> Maybe DialogCodeHookSettings
dialogCodeHook :: Prelude.Maybe DialogCodeHookSettings,
    -- | The fulfillment Lambda function specified for the intent.
    CreateIntentResponse -> Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook :: Prelude.Maybe FulfillmentCodeHookSettings,
    -- | Configuration settings for the response that is sent to the user at the
    -- beginning of a conversation, before eliciting slot values.
    CreateIntentResponse -> Maybe InitialResponseSetting
initialResponseSetting :: Prelude.Maybe InitialResponseSetting,
    -- | The list of input contexts specified for the intent.
    CreateIntentResponse -> Maybe [InputContext]
inputContexts :: Prelude.Maybe [InputContext],
    -- | The closing setting specified for the intent.
    CreateIntentResponse -> Maybe IntentClosingSetting
intentClosingSetting :: Prelude.Maybe IntentClosingSetting,
    -- | The confirmation setting specified for the intent.
    CreateIntentResponse -> Maybe IntentConfirmationSetting
intentConfirmationSetting :: Prelude.Maybe IntentConfirmationSetting,
    -- | A unique identifier for the intent.
    CreateIntentResponse -> Maybe Text
intentId :: Prelude.Maybe Prelude.Text,
    -- | The name specified for the intent.
    CreateIntentResponse -> Maybe Text
intentName :: Prelude.Maybe Prelude.Text,
    -- | Configuration for searching a Amazon Kendra index specified for the
    -- intent.
    CreateIntentResponse -> Maybe KendraConfiguration
kendraConfiguration :: Prelude.Maybe KendraConfiguration,
    -- | The locale that the intent is specified to use.
    CreateIntentResponse -> Maybe Text
localeId :: Prelude.Maybe Prelude.Text,
    -- | The list of output contexts specified for the intent.
    CreateIntentResponse -> Maybe [OutputContext]
outputContexts :: Prelude.Maybe [OutputContext],
    -- | The signature of the parent intent specified for the intent.
    CreateIntentResponse -> Maybe Text
parentIntentSignature :: Prelude.Maybe Prelude.Text,
    -- | The sample utterances specified for the intent.
    CreateIntentResponse -> Maybe [SampleUtterance]
sampleUtterances :: Prelude.Maybe [SampleUtterance],
    -- | The response's http status code.
    CreateIntentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateIntentResponse -> CreateIntentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIntentResponse -> CreateIntentResponse -> Bool
$c/= :: CreateIntentResponse -> CreateIntentResponse -> Bool
== :: CreateIntentResponse -> CreateIntentResponse -> Bool
$c== :: CreateIntentResponse -> CreateIntentResponse -> Bool
Prelude.Eq, ReadPrec [CreateIntentResponse]
ReadPrec CreateIntentResponse
Int -> ReadS CreateIntentResponse
ReadS [CreateIntentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIntentResponse]
$creadListPrec :: ReadPrec [CreateIntentResponse]
readPrec :: ReadPrec CreateIntentResponse
$creadPrec :: ReadPrec CreateIntentResponse
readList :: ReadS [CreateIntentResponse]
$creadList :: ReadS [CreateIntentResponse]
readsPrec :: Int -> ReadS CreateIntentResponse
$creadsPrec :: Int -> ReadS CreateIntentResponse
Prelude.Read, Int -> CreateIntentResponse -> ShowS
[CreateIntentResponse] -> ShowS
CreateIntentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIntentResponse] -> ShowS
$cshowList :: [CreateIntentResponse] -> ShowS
show :: CreateIntentResponse -> String
$cshow :: CreateIntentResponse -> String
showsPrec :: Int -> CreateIntentResponse -> ShowS
$cshowsPrec :: Int -> CreateIntentResponse -> ShowS
Prelude.Show, forall x. Rep CreateIntentResponse x -> CreateIntentResponse
forall x. CreateIntentResponse -> Rep CreateIntentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIntentResponse x -> CreateIntentResponse
$cfrom :: forall x. CreateIntentResponse -> Rep CreateIntentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateIntentResponse' 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:
--
-- 'botId', 'createIntentResponse_botId' - The identifier of the bot associated with the intent.
--
-- 'botVersion', 'createIntentResponse_botVersion' - The identifier of the version of the bot associated with the intent.
--
-- 'creationDateTime', 'createIntentResponse_creationDateTime' - A timestamp of the date and time that the intent was created.
--
-- 'description', 'createIntentResponse_description' - The description specified for the intent.
--
-- 'dialogCodeHook', 'createIntentResponse_dialogCodeHook' - The dialog Lambda function specified for the intent.
--
-- 'fulfillmentCodeHook', 'createIntentResponse_fulfillmentCodeHook' - The fulfillment Lambda function specified for the intent.
--
-- 'initialResponseSetting', 'createIntentResponse_initialResponseSetting' - Configuration settings for the response that is sent to the user at the
-- beginning of a conversation, before eliciting slot values.
--
-- 'inputContexts', 'createIntentResponse_inputContexts' - The list of input contexts specified for the intent.
--
-- 'intentClosingSetting', 'createIntentResponse_intentClosingSetting' - The closing setting specified for the intent.
--
-- 'intentConfirmationSetting', 'createIntentResponse_intentConfirmationSetting' - The confirmation setting specified for the intent.
--
-- 'intentId', 'createIntentResponse_intentId' - A unique identifier for the intent.
--
-- 'intentName', 'createIntentResponse_intentName' - The name specified for the intent.
--
-- 'kendraConfiguration', 'createIntentResponse_kendraConfiguration' - Configuration for searching a Amazon Kendra index specified for the
-- intent.
--
-- 'localeId', 'createIntentResponse_localeId' - The locale that the intent is specified to use.
--
-- 'outputContexts', 'createIntentResponse_outputContexts' - The list of output contexts specified for the intent.
--
-- 'parentIntentSignature', 'createIntentResponse_parentIntentSignature' - The signature of the parent intent specified for the intent.
--
-- 'sampleUtterances', 'createIntentResponse_sampleUtterances' - The sample utterances specified for the intent.
--
-- 'httpStatus', 'createIntentResponse_httpStatus' - The response's http status code.
newCreateIntentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateIntentResponse
newCreateIntentResponse :: Int -> CreateIntentResponse
newCreateIntentResponse Int
pHttpStatus_ =
  CreateIntentResponse'
    { $sel:botId:CreateIntentResponse' :: Maybe Text
botId = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:CreateIntentResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:CreateIntentResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateIntentResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dialogCodeHook:CreateIntentResponse' :: Maybe DialogCodeHookSettings
dialogCodeHook = forall a. Maybe a
Prelude.Nothing,
      $sel:fulfillmentCodeHook:CreateIntentResponse' :: Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook = forall a. Maybe a
Prelude.Nothing,
      $sel:initialResponseSetting:CreateIntentResponse' :: Maybe InitialResponseSetting
initialResponseSetting = forall a. Maybe a
Prelude.Nothing,
      $sel:inputContexts:CreateIntentResponse' :: Maybe [InputContext]
inputContexts = forall a. Maybe a
Prelude.Nothing,
      $sel:intentClosingSetting:CreateIntentResponse' :: Maybe IntentClosingSetting
intentClosingSetting = forall a. Maybe a
Prelude.Nothing,
      $sel:intentConfirmationSetting:CreateIntentResponse' :: Maybe IntentConfirmationSetting
intentConfirmationSetting = forall a. Maybe a
Prelude.Nothing,
      $sel:intentId:CreateIntentResponse' :: Maybe Text
intentId = forall a. Maybe a
Prelude.Nothing,
      $sel:intentName:CreateIntentResponse' :: Maybe Text
intentName = forall a. Maybe a
Prelude.Nothing,
      $sel:kendraConfiguration:CreateIntentResponse' :: Maybe KendraConfiguration
kendraConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:localeId:CreateIntentResponse' :: Maybe Text
localeId = forall a. Maybe a
Prelude.Nothing,
      $sel:outputContexts:CreateIntentResponse' :: Maybe [OutputContext]
outputContexts = forall a. Maybe a
Prelude.Nothing,
      $sel:parentIntentSignature:CreateIntentResponse' :: Maybe Text
parentIntentSignature = forall a. Maybe a
Prelude.Nothing,
      $sel:sampleUtterances:CreateIntentResponse' :: Maybe [SampleUtterance]
sampleUtterances = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateIntentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the bot associated with the intent.
createIntentResponse_botId :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.Text)
createIntentResponse_botId :: Lens' CreateIntentResponse (Maybe Text)
createIntentResponse_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe Text
botId :: Maybe Text
$sel:botId:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
botId} -> Maybe Text
botId) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe Text
a -> CreateIntentResponse
s {$sel:botId:CreateIntentResponse' :: Maybe Text
botId = Maybe Text
a} :: CreateIntentResponse)

-- | The identifier of the version of the bot associated with the intent.
createIntentResponse_botVersion :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.Text)
createIntentResponse_botVersion :: Lens' CreateIntentResponse (Maybe Text)
createIntentResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe Text
a -> CreateIntentResponse
s {$sel:botVersion:CreateIntentResponse' :: Maybe Text
botVersion = Maybe Text
a} :: CreateIntentResponse)

-- | A timestamp of the date and time that the intent was created.
createIntentResponse_creationDateTime :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.UTCTime)
createIntentResponse_creationDateTime :: Lens' CreateIntentResponse (Maybe UTCTime)
createIntentResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:CreateIntentResponse' :: CreateIntentResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe POSIX
a -> CreateIntentResponse
s {$sel:creationDateTime:CreateIntentResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: CreateIntentResponse) 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

-- | The description specified for the intent.
createIntentResponse_description :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.Text)
createIntentResponse_description :: Lens' CreateIntentResponse (Maybe Text)
createIntentResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe Text
a -> CreateIntentResponse
s {$sel:description:CreateIntentResponse' :: Maybe Text
description = Maybe Text
a} :: CreateIntentResponse)

-- | The dialog Lambda function specified for the intent.
createIntentResponse_dialogCodeHook :: Lens.Lens' CreateIntentResponse (Prelude.Maybe DialogCodeHookSettings)
createIntentResponse_dialogCodeHook :: Lens' CreateIntentResponse (Maybe DialogCodeHookSettings)
createIntentResponse_dialogCodeHook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe DialogCodeHookSettings
dialogCodeHook :: Maybe DialogCodeHookSettings
$sel:dialogCodeHook:CreateIntentResponse' :: CreateIntentResponse -> Maybe DialogCodeHookSettings
dialogCodeHook} -> Maybe DialogCodeHookSettings
dialogCodeHook) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe DialogCodeHookSettings
a -> CreateIntentResponse
s {$sel:dialogCodeHook:CreateIntentResponse' :: Maybe DialogCodeHookSettings
dialogCodeHook = Maybe DialogCodeHookSettings
a} :: CreateIntentResponse)

-- | The fulfillment Lambda function specified for the intent.
createIntentResponse_fulfillmentCodeHook :: Lens.Lens' CreateIntentResponse (Prelude.Maybe FulfillmentCodeHookSettings)
createIntentResponse_fulfillmentCodeHook :: Lens' CreateIntentResponse (Maybe FulfillmentCodeHookSettings)
createIntentResponse_fulfillmentCodeHook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook :: Maybe FulfillmentCodeHookSettings
$sel:fulfillmentCodeHook:CreateIntentResponse' :: CreateIntentResponse -> Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook} -> Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe FulfillmentCodeHookSettings
a -> CreateIntentResponse
s {$sel:fulfillmentCodeHook:CreateIntentResponse' :: Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook = Maybe FulfillmentCodeHookSettings
a} :: CreateIntentResponse)

-- | Configuration settings for the response that is sent to the user at the
-- beginning of a conversation, before eliciting slot values.
createIntentResponse_initialResponseSetting :: Lens.Lens' CreateIntentResponse (Prelude.Maybe InitialResponseSetting)
createIntentResponse_initialResponseSetting :: Lens' CreateIntentResponse (Maybe InitialResponseSetting)
createIntentResponse_initialResponseSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe InitialResponseSetting
initialResponseSetting :: Maybe InitialResponseSetting
$sel:initialResponseSetting:CreateIntentResponse' :: CreateIntentResponse -> Maybe InitialResponseSetting
initialResponseSetting} -> Maybe InitialResponseSetting
initialResponseSetting) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe InitialResponseSetting
a -> CreateIntentResponse
s {$sel:initialResponseSetting:CreateIntentResponse' :: Maybe InitialResponseSetting
initialResponseSetting = Maybe InitialResponseSetting
a} :: CreateIntentResponse)

-- | The list of input contexts specified for the intent.
createIntentResponse_inputContexts :: Lens.Lens' CreateIntentResponse (Prelude.Maybe [InputContext])
createIntentResponse_inputContexts :: Lens' CreateIntentResponse (Maybe [InputContext])
createIntentResponse_inputContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe [InputContext]
inputContexts :: Maybe [InputContext]
$sel:inputContexts:CreateIntentResponse' :: CreateIntentResponse -> Maybe [InputContext]
inputContexts} -> Maybe [InputContext]
inputContexts) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe [InputContext]
a -> CreateIntentResponse
s {$sel:inputContexts:CreateIntentResponse' :: Maybe [InputContext]
inputContexts = Maybe [InputContext]
a} :: CreateIntentResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The closing setting specified for the intent.
createIntentResponse_intentClosingSetting :: Lens.Lens' CreateIntentResponse (Prelude.Maybe IntentClosingSetting)
createIntentResponse_intentClosingSetting :: Lens' CreateIntentResponse (Maybe IntentClosingSetting)
createIntentResponse_intentClosingSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe IntentClosingSetting
intentClosingSetting :: Maybe IntentClosingSetting
$sel:intentClosingSetting:CreateIntentResponse' :: CreateIntentResponse -> Maybe IntentClosingSetting
intentClosingSetting} -> Maybe IntentClosingSetting
intentClosingSetting) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe IntentClosingSetting
a -> CreateIntentResponse
s {$sel:intentClosingSetting:CreateIntentResponse' :: Maybe IntentClosingSetting
intentClosingSetting = Maybe IntentClosingSetting
a} :: CreateIntentResponse)

-- | The confirmation setting specified for the intent.
createIntentResponse_intentConfirmationSetting :: Lens.Lens' CreateIntentResponse (Prelude.Maybe IntentConfirmationSetting)
createIntentResponse_intentConfirmationSetting :: Lens' CreateIntentResponse (Maybe IntentConfirmationSetting)
createIntentResponse_intentConfirmationSetting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe IntentConfirmationSetting
intentConfirmationSetting :: Maybe IntentConfirmationSetting
$sel:intentConfirmationSetting:CreateIntentResponse' :: CreateIntentResponse -> Maybe IntentConfirmationSetting
intentConfirmationSetting} -> Maybe IntentConfirmationSetting
intentConfirmationSetting) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe IntentConfirmationSetting
a -> CreateIntentResponse
s {$sel:intentConfirmationSetting:CreateIntentResponse' :: Maybe IntentConfirmationSetting
intentConfirmationSetting = Maybe IntentConfirmationSetting
a} :: CreateIntentResponse)

-- | A unique identifier for the intent.
createIntentResponse_intentId :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.Text)
createIntentResponse_intentId :: Lens' CreateIntentResponse (Maybe Text)
createIntentResponse_intentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe Text
intentId :: Maybe Text
$sel:intentId:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
intentId} -> Maybe Text
intentId) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe Text
a -> CreateIntentResponse
s {$sel:intentId:CreateIntentResponse' :: Maybe Text
intentId = Maybe Text
a} :: CreateIntentResponse)

-- | The name specified for the intent.
createIntentResponse_intentName :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.Text)
createIntentResponse_intentName :: Lens' CreateIntentResponse (Maybe Text)
createIntentResponse_intentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe Text
intentName :: Maybe Text
$sel:intentName:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
intentName} -> Maybe Text
intentName) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe Text
a -> CreateIntentResponse
s {$sel:intentName:CreateIntentResponse' :: Maybe Text
intentName = Maybe Text
a} :: CreateIntentResponse)

-- | Configuration for searching a Amazon Kendra index specified for the
-- intent.
createIntentResponse_kendraConfiguration :: Lens.Lens' CreateIntentResponse (Prelude.Maybe KendraConfiguration)
createIntentResponse_kendraConfiguration :: Lens' CreateIntentResponse (Maybe KendraConfiguration)
createIntentResponse_kendraConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe KendraConfiguration
kendraConfiguration :: Maybe KendraConfiguration
$sel:kendraConfiguration:CreateIntentResponse' :: CreateIntentResponse -> Maybe KendraConfiguration
kendraConfiguration} -> Maybe KendraConfiguration
kendraConfiguration) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe KendraConfiguration
a -> CreateIntentResponse
s {$sel:kendraConfiguration:CreateIntentResponse' :: Maybe KendraConfiguration
kendraConfiguration = Maybe KendraConfiguration
a} :: CreateIntentResponse)

-- | The locale that the intent is specified to use.
createIntentResponse_localeId :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.Text)
createIntentResponse_localeId :: Lens' CreateIntentResponse (Maybe Text)
createIntentResponse_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe Text
localeId :: Maybe Text
$sel:localeId:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
localeId} -> Maybe Text
localeId) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe Text
a -> CreateIntentResponse
s {$sel:localeId:CreateIntentResponse' :: Maybe Text
localeId = Maybe Text
a} :: CreateIntentResponse)

-- | The list of output contexts specified for the intent.
createIntentResponse_outputContexts :: Lens.Lens' CreateIntentResponse (Prelude.Maybe [OutputContext])
createIntentResponse_outputContexts :: Lens' CreateIntentResponse (Maybe [OutputContext])
createIntentResponse_outputContexts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe [OutputContext]
outputContexts :: Maybe [OutputContext]
$sel:outputContexts:CreateIntentResponse' :: CreateIntentResponse -> Maybe [OutputContext]
outputContexts} -> Maybe [OutputContext]
outputContexts) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe [OutputContext]
a -> CreateIntentResponse
s {$sel:outputContexts:CreateIntentResponse' :: Maybe [OutputContext]
outputContexts = Maybe [OutputContext]
a} :: CreateIntentResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The signature of the parent intent specified for the intent.
createIntentResponse_parentIntentSignature :: Lens.Lens' CreateIntentResponse (Prelude.Maybe Prelude.Text)
createIntentResponse_parentIntentSignature :: Lens' CreateIntentResponse (Maybe Text)
createIntentResponse_parentIntentSignature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe Text
parentIntentSignature :: Maybe Text
$sel:parentIntentSignature:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
parentIntentSignature} -> Maybe Text
parentIntentSignature) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe Text
a -> CreateIntentResponse
s {$sel:parentIntentSignature:CreateIntentResponse' :: Maybe Text
parentIntentSignature = Maybe Text
a} :: CreateIntentResponse)

-- | The sample utterances specified for the intent.
createIntentResponse_sampleUtterances :: Lens.Lens' CreateIntentResponse (Prelude.Maybe [SampleUtterance])
createIntentResponse_sampleUtterances :: Lens' CreateIntentResponse (Maybe [SampleUtterance])
createIntentResponse_sampleUtterances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIntentResponse' {Maybe [SampleUtterance]
sampleUtterances :: Maybe [SampleUtterance]
$sel:sampleUtterances:CreateIntentResponse' :: CreateIntentResponse -> Maybe [SampleUtterance]
sampleUtterances} -> Maybe [SampleUtterance]
sampleUtterances) (\s :: CreateIntentResponse
s@CreateIntentResponse' {} Maybe [SampleUtterance]
a -> CreateIntentResponse
s {$sel:sampleUtterances:CreateIntentResponse' :: Maybe [SampleUtterance]
sampleUtterances = Maybe [SampleUtterance]
a} :: CreateIntentResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData CreateIntentResponse where
  rnf :: CreateIntentResponse -> ()
rnf CreateIntentResponse' {Int
Maybe [InputContext]
Maybe [OutputContext]
Maybe [SampleUtterance]
Maybe Text
Maybe POSIX
Maybe DialogCodeHookSettings
Maybe KendraConfiguration
Maybe FulfillmentCodeHookSettings
Maybe IntentClosingSetting
Maybe InitialResponseSetting
Maybe IntentConfirmationSetting
httpStatus :: Int
sampleUtterances :: Maybe [SampleUtterance]
parentIntentSignature :: Maybe Text
outputContexts :: Maybe [OutputContext]
localeId :: Maybe Text
kendraConfiguration :: Maybe KendraConfiguration
intentName :: Maybe Text
intentId :: Maybe Text
intentConfirmationSetting :: Maybe IntentConfirmationSetting
intentClosingSetting :: Maybe IntentClosingSetting
inputContexts :: Maybe [InputContext]
initialResponseSetting :: Maybe InitialResponseSetting
fulfillmentCodeHook :: Maybe FulfillmentCodeHookSettings
dialogCodeHook :: Maybe DialogCodeHookSettings
description :: Maybe Text
creationDateTime :: Maybe POSIX
botVersion :: Maybe Text
botId :: Maybe Text
$sel:httpStatus:CreateIntentResponse' :: CreateIntentResponse -> Int
$sel:sampleUtterances:CreateIntentResponse' :: CreateIntentResponse -> Maybe [SampleUtterance]
$sel:parentIntentSignature:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
$sel:outputContexts:CreateIntentResponse' :: CreateIntentResponse -> Maybe [OutputContext]
$sel:localeId:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
$sel:kendraConfiguration:CreateIntentResponse' :: CreateIntentResponse -> Maybe KendraConfiguration
$sel:intentName:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
$sel:intentId:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
$sel:intentConfirmationSetting:CreateIntentResponse' :: CreateIntentResponse -> Maybe IntentConfirmationSetting
$sel:intentClosingSetting:CreateIntentResponse' :: CreateIntentResponse -> Maybe IntentClosingSetting
$sel:inputContexts:CreateIntentResponse' :: CreateIntentResponse -> Maybe [InputContext]
$sel:initialResponseSetting:CreateIntentResponse' :: CreateIntentResponse -> Maybe InitialResponseSetting
$sel:fulfillmentCodeHook:CreateIntentResponse' :: CreateIntentResponse -> Maybe FulfillmentCodeHookSettings
$sel:dialogCodeHook:CreateIntentResponse' :: CreateIntentResponse -> Maybe DialogCodeHookSettings
$sel:description:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
$sel:creationDateTime:CreateIntentResponse' :: CreateIntentResponse -> Maybe POSIX
$sel:botVersion:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
$sel:botId:CreateIntentResponse' :: CreateIntentResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDateTime
      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 DialogCodeHookSettings
dialogCodeHook
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FulfillmentCodeHookSettings
fulfillmentCodeHook
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InitialResponseSetting
initialResponseSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputContext]
inputContexts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IntentClosingSetting
intentClosingSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IntentConfirmationSetting
intentConfirmationSetting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
intentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
intentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KendraConfiguration
kendraConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
localeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OutputContext]
outputContexts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentIntentSignature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SampleUtterance]
sampleUtterances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus