{-# 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.LexModels.GetBuiltinIntent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about a built-in intent.
--
-- This operation requires permission for the @lex:GetBuiltinIntent@
-- action.
module Amazonka.LexModels.GetBuiltinIntent
  ( -- * Creating a Request
    GetBuiltinIntent (..),
    newGetBuiltinIntent,

    -- * Request Lenses
    getBuiltinIntent_signature,

    -- * Destructuring the Response
    GetBuiltinIntentResponse (..),
    newGetBuiltinIntentResponse,

    -- * Response Lenses
    getBuiltinIntentResponse_signature,
    getBuiltinIntentResponse_slots,
    getBuiltinIntentResponse_supportedLocales,
    getBuiltinIntentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetBuiltinIntent' smart constructor.
data GetBuiltinIntent = GetBuiltinIntent'
  { -- | The unique identifier for a built-in intent. To find the signature for
    -- an intent, see
    -- <https://developer.amazon.com/public/solutions/alexa/alexa-skills-kit/docs/built-in-intent-ref/standard-intents Standard Built-in Intents>
    -- in the /Alexa Skills Kit/.
    GetBuiltinIntent -> Text
signature :: Prelude.Text
  }
  deriving (GetBuiltinIntent -> GetBuiltinIntent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBuiltinIntent -> GetBuiltinIntent -> Bool
$c/= :: GetBuiltinIntent -> GetBuiltinIntent -> Bool
== :: GetBuiltinIntent -> GetBuiltinIntent -> Bool
$c== :: GetBuiltinIntent -> GetBuiltinIntent -> Bool
Prelude.Eq, ReadPrec [GetBuiltinIntent]
ReadPrec GetBuiltinIntent
Int -> ReadS GetBuiltinIntent
ReadS [GetBuiltinIntent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBuiltinIntent]
$creadListPrec :: ReadPrec [GetBuiltinIntent]
readPrec :: ReadPrec GetBuiltinIntent
$creadPrec :: ReadPrec GetBuiltinIntent
readList :: ReadS [GetBuiltinIntent]
$creadList :: ReadS [GetBuiltinIntent]
readsPrec :: Int -> ReadS GetBuiltinIntent
$creadsPrec :: Int -> ReadS GetBuiltinIntent
Prelude.Read, Int -> GetBuiltinIntent -> ShowS
[GetBuiltinIntent] -> ShowS
GetBuiltinIntent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBuiltinIntent] -> ShowS
$cshowList :: [GetBuiltinIntent] -> ShowS
show :: GetBuiltinIntent -> String
$cshow :: GetBuiltinIntent -> String
showsPrec :: Int -> GetBuiltinIntent -> ShowS
$cshowsPrec :: Int -> GetBuiltinIntent -> ShowS
Prelude.Show, forall x. Rep GetBuiltinIntent x -> GetBuiltinIntent
forall x. GetBuiltinIntent -> Rep GetBuiltinIntent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBuiltinIntent x -> GetBuiltinIntent
$cfrom :: forall x. GetBuiltinIntent -> Rep GetBuiltinIntent x
Prelude.Generic)

-- |
-- Create a value of 'GetBuiltinIntent' 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:
--
-- 'signature', 'getBuiltinIntent_signature' - The unique identifier for a built-in intent. To find the signature for
-- an intent, see
-- <https://developer.amazon.com/public/solutions/alexa/alexa-skills-kit/docs/built-in-intent-ref/standard-intents Standard Built-in Intents>
-- in the /Alexa Skills Kit/.
newGetBuiltinIntent ::
  -- | 'signature'
  Prelude.Text ->
  GetBuiltinIntent
newGetBuiltinIntent :: Text -> GetBuiltinIntent
newGetBuiltinIntent Text
pSignature_ =
  GetBuiltinIntent' {$sel:signature:GetBuiltinIntent' :: Text
signature = Text
pSignature_}

-- | The unique identifier for a built-in intent. To find the signature for
-- an intent, see
-- <https://developer.amazon.com/public/solutions/alexa/alexa-skills-kit/docs/built-in-intent-ref/standard-intents Standard Built-in Intents>
-- in the /Alexa Skills Kit/.
getBuiltinIntent_signature :: Lens.Lens' GetBuiltinIntent Prelude.Text
getBuiltinIntent_signature :: Lens' GetBuiltinIntent Text
getBuiltinIntent_signature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBuiltinIntent' {Text
signature :: Text
$sel:signature:GetBuiltinIntent' :: GetBuiltinIntent -> Text
signature} -> Text
signature) (\s :: GetBuiltinIntent
s@GetBuiltinIntent' {} Text
a -> GetBuiltinIntent
s {$sel:signature:GetBuiltinIntent' :: Text
signature = Text
a} :: GetBuiltinIntent)

instance Core.AWSRequest GetBuiltinIntent where
  type
    AWSResponse GetBuiltinIntent =
      GetBuiltinIntentResponse
  request :: (Service -> Service)
-> GetBuiltinIntent -> Request GetBuiltinIntent
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetBuiltinIntent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetBuiltinIntent)))
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 [BuiltinIntentSlot]
-> Maybe [Locale]
-> Int
-> GetBuiltinIntentResponse
GetBuiltinIntentResponse'
            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
"signature")
            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
"slots" 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
"supportedLocales"
                            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 GetBuiltinIntent where
  hashWithSalt :: Int -> GetBuiltinIntent -> Int
hashWithSalt Int
_salt GetBuiltinIntent' {Text
signature :: Text
$sel:signature:GetBuiltinIntent' :: GetBuiltinIntent -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
signature

instance Prelude.NFData GetBuiltinIntent where
  rnf :: GetBuiltinIntent -> ()
rnf GetBuiltinIntent' {Text
signature :: Text
$sel:signature:GetBuiltinIntent' :: GetBuiltinIntent -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
signature

instance Data.ToHeaders GetBuiltinIntent where
  toHeaders :: GetBuiltinIntent -> 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.ToPath GetBuiltinIntent where
  toPath :: GetBuiltinIntent -> ByteString
toPath GetBuiltinIntent' {Text
signature :: Text
$sel:signature:GetBuiltinIntent' :: GetBuiltinIntent -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/builtins/intents/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
signature]

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

-- | /See:/ 'newGetBuiltinIntentResponse' smart constructor.
data GetBuiltinIntentResponse = GetBuiltinIntentResponse'
  { -- | The unique identifier for a built-in intent.
    GetBuiltinIntentResponse -> Maybe Text
signature :: Prelude.Maybe Prelude.Text,
    -- | An array of @BuiltinIntentSlot@ objects, one entry for each slot type in
    -- the intent.
    GetBuiltinIntentResponse -> Maybe [BuiltinIntentSlot]
slots :: Prelude.Maybe [BuiltinIntentSlot],
    -- | A list of locales that the intent supports.
    GetBuiltinIntentResponse -> Maybe [Locale]
supportedLocales :: Prelude.Maybe [Locale],
    -- | The response's http status code.
    GetBuiltinIntentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBuiltinIntentResponse -> GetBuiltinIntentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBuiltinIntentResponse -> GetBuiltinIntentResponse -> Bool
$c/= :: GetBuiltinIntentResponse -> GetBuiltinIntentResponse -> Bool
== :: GetBuiltinIntentResponse -> GetBuiltinIntentResponse -> Bool
$c== :: GetBuiltinIntentResponse -> GetBuiltinIntentResponse -> Bool
Prelude.Eq, ReadPrec [GetBuiltinIntentResponse]
ReadPrec GetBuiltinIntentResponse
Int -> ReadS GetBuiltinIntentResponse
ReadS [GetBuiltinIntentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBuiltinIntentResponse]
$creadListPrec :: ReadPrec [GetBuiltinIntentResponse]
readPrec :: ReadPrec GetBuiltinIntentResponse
$creadPrec :: ReadPrec GetBuiltinIntentResponse
readList :: ReadS [GetBuiltinIntentResponse]
$creadList :: ReadS [GetBuiltinIntentResponse]
readsPrec :: Int -> ReadS GetBuiltinIntentResponse
$creadsPrec :: Int -> ReadS GetBuiltinIntentResponse
Prelude.Read, Int -> GetBuiltinIntentResponse -> ShowS
[GetBuiltinIntentResponse] -> ShowS
GetBuiltinIntentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBuiltinIntentResponse] -> ShowS
$cshowList :: [GetBuiltinIntentResponse] -> ShowS
show :: GetBuiltinIntentResponse -> String
$cshow :: GetBuiltinIntentResponse -> String
showsPrec :: Int -> GetBuiltinIntentResponse -> ShowS
$cshowsPrec :: Int -> GetBuiltinIntentResponse -> ShowS
Prelude.Show, forall x.
Rep GetBuiltinIntentResponse x -> GetBuiltinIntentResponse
forall x.
GetBuiltinIntentResponse -> Rep GetBuiltinIntentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBuiltinIntentResponse x -> GetBuiltinIntentResponse
$cfrom :: forall x.
GetBuiltinIntentResponse -> Rep GetBuiltinIntentResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBuiltinIntentResponse' 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:
--
-- 'signature', 'getBuiltinIntentResponse_signature' - The unique identifier for a built-in intent.
--
-- 'slots', 'getBuiltinIntentResponse_slots' - An array of @BuiltinIntentSlot@ objects, one entry for each slot type in
-- the intent.
--
-- 'supportedLocales', 'getBuiltinIntentResponse_supportedLocales' - A list of locales that the intent supports.
--
-- 'httpStatus', 'getBuiltinIntentResponse_httpStatus' - The response's http status code.
newGetBuiltinIntentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBuiltinIntentResponse
newGetBuiltinIntentResponse :: Int -> GetBuiltinIntentResponse
newGetBuiltinIntentResponse Int
pHttpStatus_ =
  GetBuiltinIntentResponse'
    { $sel:signature:GetBuiltinIntentResponse' :: Maybe Text
signature =
        forall a. Maybe a
Prelude.Nothing,
      $sel:slots:GetBuiltinIntentResponse' :: Maybe [BuiltinIntentSlot]
slots = forall a. Maybe a
Prelude.Nothing,
      $sel:supportedLocales:GetBuiltinIntentResponse' :: Maybe [Locale]
supportedLocales = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBuiltinIntentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier for a built-in intent.
getBuiltinIntentResponse_signature :: Lens.Lens' GetBuiltinIntentResponse (Prelude.Maybe Prelude.Text)
getBuiltinIntentResponse_signature :: Lens' GetBuiltinIntentResponse (Maybe Text)
getBuiltinIntentResponse_signature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBuiltinIntentResponse' {Maybe Text
signature :: Maybe Text
$sel:signature:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Maybe Text
signature} -> Maybe Text
signature) (\s :: GetBuiltinIntentResponse
s@GetBuiltinIntentResponse' {} Maybe Text
a -> GetBuiltinIntentResponse
s {$sel:signature:GetBuiltinIntentResponse' :: Maybe Text
signature = Maybe Text
a} :: GetBuiltinIntentResponse)

-- | An array of @BuiltinIntentSlot@ objects, one entry for each slot type in
-- the intent.
getBuiltinIntentResponse_slots :: Lens.Lens' GetBuiltinIntentResponse (Prelude.Maybe [BuiltinIntentSlot])
getBuiltinIntentResponse_slots :: Lens' GetBuiltinIntentResponse (Maybe [BuiltinIntentSlot])
getBuiltinIntentResponse_slots = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBuiltinIntentResponse' {Maybe [BuiltinIntentSlot]
slots :: Maybe [BuiltinIntentSlot]
$sel:slots:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Maybe [BuiltinIntentSlot]
slots} -> Maybe [BuiltinIntentSlot]
slots) (\s :: GetBuiltinIntentResponse
s@GetBuiltinIntentResponse' {} Maybe [BuiltinIntentSlot]
a -> GetBuiltinIntentResponse
s {$sel:slots:GetBuiltinIntentResponse' :: Maybe [BuiltinIntentSlot]
slots = Maybe [BuiltinIntentSlot]
a} :: GetBuiltinIntentResponse) 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 list of locales that the intent supports.
getBuiltinIntentResponse_supportedLocales :: Lens.Lens' GetBuiltinIntentResponse (Prelude.Maybe [Locale])
getBuiltinIntentResponse_supportedLocales :: Lens' GetBuiltinIntentResponse (Maybe [Locale])
getBuiltinIntentResponse_supportedLocales = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBuiltinIntentResponse' {Maybe [Locale]
supportedLocales :: Maybe [Locale]
$sel:supportedLocales:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Maybe [Locale]
supportedLocales} -> Maybe [Locale]
supportedLocales) (\s :: GetBuiltinIntentResponse
s@GetBuiltinIntentResponse' {} Maybe [Locale]
a -> GetBuiltinIntentResponse
s {$sel:supportedLocales:GetBuiltinIntentResponse' :: Maybe [Locale]
supportedLocales = Maybe [Locale]
a} :: GetBuiltinIntentResponse) 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.
getBuiltinIntentResponse_httpStatus :: Lens.Lens' GetBuiltinIntentResponse Prelude.Int
getBuiltinIntentResponse_httpStatus :: Lens' GetBuiltinIntentResponse Int
getBuiltinIntentResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBuiltinIntentResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetBuiltinIntentResponse
s@GetBuiltinIntentResponse' {} Int
a -> GetBuiltinIntentResponse
s {$sel:httpStatus:GetBuiltinIntentResponse' :: Int
httpStatus = Int
a} :: GetBuiltinIntentResponse)

instance Prelude.NFData GetBuiltinIntentResponse where
  rnf :: GetBuiltinIntentResponse -> ()
rnf GetBuiltinIntentResponse' {Int
Maybe [BuiltinIntentSlot]
Maybe [Locale]
Maybe Text
httpStatus :: Int
supportedLocales :: Maybe [Locale]
slots :: Maybe [BuiltinIntentSlot]
signature :: Maybe Text
$sel:httpStatus:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Int
$sel:supportedLocales:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Maybe [Locale]
$sel:slots:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Maybe [BuiltinIntentSlot]
$sel:signature:GetBuiltinIntentResponse' :: GetBuiltinIntentResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
signature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BuiltinIntentSlot]
slots
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Locale]
supportedLocales
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus