{-# 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.ListBuiltInIntents
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a list of built-in intents provided by Amazon Lex that you can use
-- in your bot.
--
-- To use a built-in intent as a the base for your own intent, include the
-- built-in intent signature in the @parentIntentSignature@ parameter when
-- you call the @CreateIntent@ operation. For more information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/API_CreateIntent.html CreateIntent>.
module Amazonka.LexV2Models.ListBuiltInIntents
  ( -- * Creating a Request
    ListBuiltInIntents (..),
    newListBuiltInIntents,

    -- * Request Lenses
    listBuiltInIntents_maxResults,
    listBuiltInIntents_nextToken,
    listBuiltInIntents_sortBy,
    listBuiltInIntents_localeId,

    -- * Destructuring the Response
    ListBuiltInIntentsResponse (..),
    newListBuiltInIntentsResponse,

    -- * Response Lenses
    listBuiltInIntentsResponse_builtInIntentSummaries,
    listBuiltInIntentsResponse_localeId,
    listBuiltInIntentsResponse_nextToken,
    listBuiltInIntentsResponse_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:/ 'newListBuiltInIntents' smart constructor.
data ListBuiltInIntents = ListBuiltInIntents'
  { -- | The maximum number of built-in intents to return in each page of
    -- results. If there are fewer results than the max page size, only the
    -- actual number of results are returned.
    ListBuiltInIntents -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the response from the @ListBuiltInIntents@ operation contains more
    -- results than specified in the @maxResults@ parameter, a token is
    -- returned in the response. Use that token in the @nextToken@ parameter to
    -- return the next page of results.
    ListBuiltInIntents -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies sorting parameters for the list of built-in intents. You can
    -- specify that the list be sorted by the built-in intent signature in
    -- either ascending or descending order.
    ListBuiltInIntents -> Maybe BuiltInIntentSortBy
sortBy :: Prelude.Maybe BuiltInIntentSortBy,
    -- | The identifier of the language and locale of the intents to list. The
    -- string must match one of the supported locales. For more information,
    -- see
    -- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
    ListBuiltInIntents -> Text
localeId :: Prelude.Text
  }
  deriving (ListBuiltInIntents -> ListBuiltInIntents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBuiltInIntents -> ListBuiltInIntents -> Bool
$c/= :: ListBuiltInIntents -> ListBuiltInIntents -> Bool
== :: ListBuiltInIntents -> ListBuiltInIntents -> Bool
$c== :: ListBuiltInIntents -> ListBuiltInIntents -> Bool
Prelude.Eq, ReadPrec [ListBuiltInIntents]
ReadPrec ListBuiltInIntents
Int -> ReadS ListBuiltInIntents
ReadS [ListBuiltInIntents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBuiltInIntents]
$creadListPrec :: ReadPrec [ListBuiltInIntents]
readPrec :: ReadPrec ListBuiltInIntents
$creadPrec :: ReadPrec ListBuiltInIntents
readList :: ReadS [ListBuiltInIntents]
$creadList :: ReadS [ListBuiltInIntents]
readsPrec :: Int -> ReadS ListBuiltInIntents
$creadsPrec :: Int -> ReadS ListBuiltInIntents
Prelude.Read, Int -> ListBuiltInIntents -> ShowS
[ListBuiltInIntents] -> ShowS
ListBuiltInIntents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBuiltInIntents] -> ShowS
$cshowList :: [ListBuiltInIntents] -> ShowS
show :: ListBuiltInIntents -> String
$cshow :: ListBuiltInIntents -> String
showsPrec :: Int -> ListBuiltInIntents -> ShowS
$cshowsPrec :: Int -> ListBuiltInIntents -> ShowS
Prelude.Show, forall x. Rep ListBuiltInIntents x -> ListBuiltInIntents
forall x. ListBuiltInIntents -> Rep ListBuiltInIntents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBuiltInIntents x -> ListBuiltInIntents
$cfrom :: forall x. ListBuiltInIntents -> Rep ListBuiltInIntents x
Prelude.Generic)

-- |
-- Create a value of 'ListBuiltInIntents' 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:
--
-- 'maxResults', 'listBuiltInIntents_maxResults' - The maximum number of built-in intents to return in each page of
-- results. If there are fewer results than the max page size, only the
-- actual number of results are returned.
--
-- 'nextToken', 'listBuiltInIntents_nextToken' - If the response from the @ListBuiltInIntents@ operation contains more
-- results than specified in the @maxResults@ parameter, a token is
-- returned in the response. Use that token in the @nextToken@ parameter to
-- return the next page of results.
--
-- 'sortBy', 'listBuiltInIntents_sortBy' - Specifies sorting parameters for the list of built-in intents. You can
-- specify that the list be sorted by the built-in intent signature in
-- either ascending or descending order.
--
-- 'localeId', 'listBuiltInIntents_localeId' - The identifier of the language and locale of the intents to list. The
-- string must match one of the supported locales. For more information,
-- see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
newListBuiltInIntents ::
  -- | 'localeId'
  Prelude.Text ->
  ListBuiltInIntents
newListBuiltInIntents :: Text -> ListBuiltInIntents
newListBuiltInIntents Text
pLocaleId_ =
  ListBuiltInIntents'
    { $sel:maxResults:ListBuiltInIntents' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBuiltInIntents' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListBuiltInIntents' :: Maybe BuiltInIntentSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:localeId:ListBuiltInIntents' :: Text
localeId = Text
pLocaleId_
    }

-- | The maximum number of built-in intents to return in each page of
-- results. If there are fewer results than the max page size, only the
-- actual number of results are returned.
listBuiltInIntents_maxResults :: Lens.Lens' ListBuiltInIntents (Prelude.Maybe Prelude.Natural)
listBuiltInIntents_maxResults :: Lens' ListBuiltInIntents (Maybe Natural)
listBuiltInIntents_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuiltInIntents' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListBuiltInIntents
s@ListBuiltInIntents' {} Maybe Natural
a -> ListBuiltInIntents
s {$sel:maxResults:ListBuiltInIntents' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListBuiltInIntents)

-- | If the response from the @ListBuiltInIntents@ operation contains more
-- results than specified in the @maxResults@ parameter, a token is
-- returned in the response. Use that token in the @nextToken@ parameter to
-- return the next page of results.
listBuiltInIntents_nextToken :: Lens.Lens' ListBuiltInIntents (Prelude.Maybe Prelude.Text)
listBuiltInIntents_nextToken :: Lens' ListBuiltInIntents (Maybe Text)
listBuiltInIntents_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuiltInIntents' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBuiltInIntents
s@ListBuiltInIntents' {} Maybe Text
a -> ListBuiltInIntents
s {$sel:nextToken:ListBuiltInIntents' :: Maybe Text
nextToken = Maybe Text
a} :: ListBuiltInIntents)

-- | Specifies sorting parameters for the list of built-in intents. You can
-- specify that the list be sorted by the built-in intent signature in
-- either ascending or descending order.
listBuiltInIntents_sortBy :: Lens.Lens' ListBuiltInIntents (Prelude.Maybe BuiltInIntentSortBy)
listBuiltInIntents_sortBy :: Lens' ListBuiltInIntents (Maybe BuiltInIntentSortBy)
listBuiltInIntents_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuiltInIntents' {Maybe BuiltInIntentSortBy
sortBy :: Maybe BuiltInIntentSortBy
$sel:sortBy:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe BuiltInIntentSortBy
sortBy} -> Maybe BuiltInIntentSortBy
sortBy) (\s :: ListBuiltInIntents
s@ListBuiltInIntents' {} Maybe BuiltInIntentSortBy
a -> ListBuiltInIntents
s {$sel:sortBy:ListBuiltInIntents' :: Maybe BuiltInIntentSortBy
sortBy = Maybe BuiltInIntentSortBy
a} :: ListBuiltInIntents)

-- | The identifier of the language and locale of the intents to list. The
-- string must match one of the supported locales. For more information,
-- see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/how-languages.html Supported languages>.
listBuiltInIntents_localeId :: Lens.Lens' ListBuiltInIntents Prelude.Text
listBuiltInIntents_localeId :: Lens' ListBuiltInIntents Text
listBuiltInIntents_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuiltInIntents' {Text
localeId :: Text
$sel:localeId:ListBuiltInIntents' :: ListBuiltInIntents -> Text
localeId} -> Text
localeId) (\s :: ListBuiltInIntents
s@ListBuiltInIntents' {} Text
a -> ListBuiltInIntents
s {$sel:localeId:ListBuiltInIntents' :: Text
localeId = Text
a} :: ListBuiltInIntents)

instance Core.AWSRequest ListBuiltInIntents where
  type
    AWSResponse ListBuiltInIntents =
      ListBuiltInIntentsResponse
  request :: (Service -> Service)
-> ListBuiltInIntents -> Request ListBuiltInIntents
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListBuiltInIntents
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListBuiltInIntents)))
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 [BuiltInIntentSummary]
-> Maybe Text -> Maybe Text -> Int -> ListBuiltInIntentsResponse
ListBuiltInIntentsResponse'
            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
"builtInIntentSummaries"
                            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
"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
"nextToken")
            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 ListBuiltInIntents where
  hashWithSalt :: Int -> ListBuiltInIntents -> Int
hashWithSalt Int
_salt ListBuiltInIntents' {Maybe Natural
Maybe Text
Maybe BuiltInIntentSortBy
Text
localeId :: Text
sortBy :: Maybe BuiltInIntentSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:localeId:ListBuiltInIntents' :: ListBuiltInIntents -> Text
$sel:sortBy:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe BuiltInIntentSortBy
$sel:nextToken:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Text
$sel:maxResults:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BuiltInIntentSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
localeId

instance Prelude.NFData ListBuiltInIntents where
  rnf :: ListBuiltInIntents -> ()
rnf ListBuiltInIntents' {Maybe Natural
Maybe Text
Maybe BuiltInIntentSortBy
Text
localeId :: Text
sortBy :: Maybe BuiltInIntentSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:localeId:ListBuiltInIntents' :: ListBuiltInIntents -> Text
$sel:sortBy:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe BuiltInIntentSortBy
$sel:nextToken:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Text
$sel:maxResults:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BuiltInIntentSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
localeId

instance Data.ToHeaders ListBuiltInIntents where
  toHeaders :: ListBuiltInIntents -> 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 ListBuiltInIntents where
  toJSON :: ListBuiltInIntents -> Value
toJSON ListBuiltInIntents' {Maybe Natural
Maybe Text
Maybe BuiltInIntentSortBy
Text
localeId :: Text
sortBy :: Maybe BuiltInIntentSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:localeId:ListBuiltInIntents' :: ListBuiltInIntents -> Text
$sel:sortBy:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe BuiltInIntentSortBy
$sel:nextToken:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Text
$sel:maxResults:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"maxResults" 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 Natural
maxResults,
            (Key
"nextToken" 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
nextToken,
            (Key
"sortBy" 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 BuiltInIntentSortBy
sortBy
          ]
      )

instance Data.ToPath ListBuiltInIntents where
  toPath :: ListBuiltInIntents -> ByteString
toPath ListBuiltInIntents' {Maybe Natural
Maybe Text
Maybe BuiltInIntentSortBy
Text
localeId :: Text
sortBy :: Maybe BuiltInIntentSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:localeId:ListBuiltInIntents' :: ListBuiltInIntents -> Text
$sel:sortBy:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe BuiltInIntentSortBy
$sel:nextToken:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Text
$sel:maxResults:ListBuiltInIntents' :: ListBuiltInIntents -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/builtins/locales/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
localeId,
        ByteString
"/intents/"
      ]

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

-- | /See:/ 'newListBuiltInIntentsResponse' smart constructor.
data ListBuiltInIntentsResponse = ListBuiltInIntentsResponse'
  { -- | Summary information for the built-in intents that meet the filter
    -- criteria specified in the request. The length of the list is specified
    -- in the @maxResults@ parameter of the request. If there are more intents
    -- available, the @nextToken@ field contains a token to get the next page
    -- of results.
    ListBuiltInIntentsResponse -> Maybe [BuiltInIntentSummary]
builtInIntentSummaries :: Prelude.Maybe [BuiltInIntentSummary],
    -- | The language and locale of the intents in the list.
    ListBuiltInIntentsResponse -> Maybe Text
localeId :: Prelude.Maybe Prelude.Text,
    -- | A token that indicates whether there are more results to return in a
    -- response to the @ListBuiltInIntents@ operation. If the @nextToken@ field
    -- is present, you send the contents as the @nextToken@ parameter of a
    -- @ListBotAliases@ operation request to get the next page of results.
    ListBuiltInIntentsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBuiltInIntentsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListBuiltInIntentsResponse -> ListBuiltInIntentsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBuiltInIntentsResponse -> ListBuiltInIntentsResponse -> Bool
$c/= :: ListBuiltInIntentsResponse -> ListBuiltInIntentsResponse -> Bool
== :: ListBuiltInIntentsResponse -> ListBuiltInIntentsResponse -> Bool
$c== :: ListBuiltInIntentsResponse -> ListBuiltInIntentsResponse -> Bool
Prelude.Eq, ReadPrec [ListBuiltInIntentsResponse]
ReadPrec ListBuiltInIntentsResponse
Int -> ReadS ListBuiltInIntentsResponse
ReadS [ListBuiltInIntentsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBuiltInIntentsResponse]
$creadListPrec :: ReadPrec [ListBuiltInIntentsResponse]
readPrec :: ReadPrec ListBuiltInIntentsResponse
$creadPrec :: ReadPrec ListBuiltInIntentsResponse
readList :: ReadS [ListBuiltInIntentsResponse]
$creadList :: ReadS [ListBuiltInIntentsResponse]
readsPrec :: Int -> ReadS ListBuiltInIntentsResponse
$creadsPrec :: Int -> ReadS ListBuiltInIntentsResponse
Prelude.Read, Int -> ListBuiltInIntentsResponse -> ShowS
[ListBuiltInIntentsResponse] -> ShowS
ListBuiltInIntentsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBuiltInIntentsResponse] -> ShowS
$cshowList :: [ListBuiltInIntentsResponse] -> ShowS
show :: ListBuiltInIntentsResponse -> String
$cshow :: ListBuiltInIntentsResponse -> String
showsPrec :: Int -> ListBuiltInIntentsResponse -> ShowS
$cshowsPrec :: Int -> ListBuiltInIntentsResponse -> ShowS
Prelude.Show, forall x.
Rep ListBuiltInIntentsResponse x -> ListBuiltInIntentsResponse
forall x.
ListBuiltInIntentsResponse -> Rep ListBuiltInIntentsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListBuiltInIntentsResponse x -> ListBuiltInIntentsResponse
$cfrom :: forall x.
ListBuiltInIntentsResponse -> Rep ListBuiltInIntentsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBuiltInIntentsResponse' 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:
--
-- 'builtInIntentSummaries', 'listBuiltInIntentsResponse_builtInIntentSummaries' - Summary information for the built-in intents that meet the filter
-- criteria specified in the request. The length of the list is specified
-- in the @maxResults@ parameter of the request. If there are more intents
-- available, the @nextToken@ field contains a token to get the next page
-- of results.
--
-- 'localeId', 'listBuiltInIntentsResponse_localeId' - The language and locale of the intents in the list.
--
-- 'nextToken', 'listBuiltInIntentsResponse_nextToken' - A token that indicates whether there are more results to return in a
-- response to the @ListBuiltInIntents@ operation. If the @nextToken@ field
-- is present, you send the contents as the @nextToken@ parameter of a
-- @ListBotAliases@ operation request to get the next page of results.
--
-- 'httpStatus', 'listBuiltInIntentsResponse_httpStatus' - The response's http status code.
newListBuiltInIntentsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBuiltInIntentsResponse
newListBuiltInIntentsResponse :: Int -> ListBuiltInIntentsResponse
newListBuiltInIntentsResponse Int
pHttpStatus_ =
  ListBuiltInIntentsResponse'
    { $sel:builtInIntentSummaries:ListBuiltInIntentsResponse' :: Maybe [BuiltInIntentSummary]
builtInIntentSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:localeId:ListBuiltInIntentsResponse' :: Maybe Text
localeId = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBuiltInIntentsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBuiltInIntentsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Summary information for the built-in intents that meet the filter
-- criteria specified in the request. The length of the list is specified
-- in the @maxResults@ parameter of the request. If there are more intents
-- available, the @nextToken@ field contains a token to get the next page
-- of results.
listBuiltInIntentsResponse_builtInIntentSummaries :: Lens.Lens' ListBuiltInIntentsResponse (Prelude.Maybe [BuiltInIntentSummary])
listBuiltInIntentsResponse_builtInIntentSummaries :: Lens' ListBuiltInIntentsResponse (Maybe [BuiltInIntentSummary])
listBuiltInIntentsResponse_builtInIntentSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuiltInIntentsResponse' {Maybe [BuiltInIntentSummary]
builtInIntentSummaries :: Maybe [BuiltInIntentSummary]
$sel:builtInIntentSummaries:ListBuiltInIntentsResponse' :: ListBuiltInIntentsResponse -> Maybe [BuiltInIntentSummary]
builtInIntentSummaries} -> Maybe [BuiltInIntentSummary]
builtInIntentSummaries) (\s :: ListBuiltInIntentsResponse
s@ListBuiltInIntentsResponse' {} Maybe [BuiltInIntentSummary]
a -> ListBuiltInIntentsResponse
s {$sel:builtInIntentSummaries:ListBuiltInIntentsResponse' :: Maybe [BuiltInIntentSummary]
builtInIntentSummaries = Maybe [BuiltInIntentSummary]
a} :: ListBuiltInIntentsResponse) 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 language and locale of the intents in the list.
listBuiltInIntentsResponse_localeId :: Lens.Lens' ListBuiltInIntentsResponse (Prelude.Maybe Prelude.Text)
listBuiltInIntentsResponse_localeId :: Lens' ListBuiltInIntentsResponse (Maybe Text)
listBuiltInIntentsResponse_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuiltInIntentsResponse' {Maybe Text
localeId :: Maybe Text
$sel:localeId:ListBuiltInIntentsResponse' :: ListBuiltInIntentsResponse -> Maybe Text
localeId} -> Maybe Text
localeId) (\s :: ListBuiltInIntentsResponse
s@ListBuiltInIntentsResponse' {} Maybe Text
a -> ListBuiltInIntentsResponse
s {$sel:localeId:ListBuiltInIntentsResponse' :: Maybe Text
localeId = Maybe Text
a} :: ListBuiltInIntentsResponse)

-- | A token that indicates whether there are more results to return in a
-- response to the @ListBuiltInIntents@ operation. If the @nextToken@ field
-- is present, you send the contents as the @nextToken@ parameter of a
-- @ListBotAliases@ operation request to get the next page of results.
listBuiltInIntentsResponse_nextToken :: Lens.Lens' ListBuiltInIntentsResponse (Prelude.Maybe Prelude.Text)
listBuiltInIntentsResponse_nextToken :: Lens' ListBuiltInIntentsResponse (Maybe Text)
listBuiltInIntentsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBuiltInIntentsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBuiltInIntentsResponse' :: ListBuiltInIntentsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBuiltInIntentsResponse
s@ListBuiltInIntentsResponse' {} Maybe Text
a -> ListBuiltInIntentsResponse
s {$sel:nextToken:ListBuiltInIntentsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListBuiltInIntentsResponse)

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

instance Prelude.NFData ListBuiltInIntentsResponse where
  rnf :: ListBuiltInIntentsResponse -> ()
rnf ListBuiltInIntentsResponse' {Int
Maybe [BuiltInIntentSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
localeId :: Maybe Text
builtInIntentSummaries :: Maybe [BuiltInIntentSummary]
$sel:httpStatus:ListBuiltInIntentsResponse' :: ListBuiltInIntentsResponse -> Int
$sel:nextToken:ListBuiltInIntentsResponse' :: ListBuiltInIntentsResponse -> Maybe Text
$sel:localeId:ListBuiltInIntentsResponse' :: ListBuiltInIntentsResponse -> Maybe Text
$sel:builtInIntentSummaries:ListBuiltInIntentsResponse' :: ListBuiltInIntentsResponse -> Maybe [BuiltInIntentSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BuiltInIntentSummary]
builtInIntentSummaries
      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 Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus