{-# 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.GetUtterancesView
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use the @GetUtterancesView@ operation to get information about the
-- utterances that your users have made to your bot. You can use this list
-- to tune the utterances that your bot responds to.
--
-- For example, say that you have created a bot to order flowers. After
-- your users have used your bot for a while, use the @GetUtterancesView@
-- operation to see the requests that they have made and whether they have
-- been successful. You might find that the utterance \"I want flowers\" is
-- not being recognized. You could add this utterance to the @OrderFlowers@
-- intent so that your bot recognizes that utterance.
--
-- After you publish a new version of a bot, you can get information about
-- the old version and the new so that you can compare the performance
-- across the two versions.
--
-- Utterance statistics are generated once a day. Data is available for the
-- last 15 days. You can request information for up to 5 versions of your
-- bot in each request. Amazon Lex returns the most frequent utterances
-- received by the bot in the last 15 days. The response contains
-- information about a maximum of 100 utterances for each version.
--
-- If you set @childDirected@ field to true when you created your bot, if
-- you are using slot obfuscation with one or more slots, or if you opted
-- out of participating in improving Amazon Lex, utterances are not
-- available.
--
-- This operation requires permissions for the @lex:GetUtterancesView@
-- action.
module Amazonka.LexModels.GetUtterancesView
  ( -- * Creating a Request
    GetUtterancesView (..),
    newGetUtterancesView,

    -- * Request Lenses
    getUtterancesView_botName,
    getUtterancesView_botVersions,
    getUtterancesView_statusType,

    -- * Destructuring the Response
    GetUtterancesViewResponse (..),
    newGetUtterancesViewResponse,

    -- * Response Lenses
    getUtterancesViewResponse_botName,
    getUtterancesViewResponse_utterances,
    getUtterancesViewResponse_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:/ 'newGetUtterancesView' smart constructor.
data GetUtterancesView = GetUtterancesView'
  { -- | The name of the bot for which utterance information should be returned.
    GetUtterancesView -> Text
botName :: Prelude.Text,
    -- | An array of bot versions for which utterance information should be
    -- returned. The limit is 5 versions per request.
    GetUtterancesView -> NonEmpty Text
botVersions :: Prelude.NonEmpty Prelude.Text,
    -- | To return utterances that were recognized and handled, use @Detected@.
    -- To return utterances that were not recognized, use @Missed@.
    GetUtterancesView -> StatusType
statusType :: StatusType
  }
  deriving (GetUtterancesView -> GetUtterancesView -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUtterancesView -> GetUtterancesView -> Bool
$c/= :: GetUtterancesView -> GetUtterancesView -> Bool
== :: GetUtterancesView -> GetUtterancesView -> Bool
$c== :: GetUtterancesView -> GetUtterancesView -> Bool
Prelude.Eq, ReadPrec [GetUtterancesView]
ReadPrec GetUtterancesView
Int -> ReadS GetUtterancesView
ReadS [GetUtterancesView]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUtterancesView]
$creadListPrec :: ReadPrec [GetUtterancesView]
readPrec :: ReadPrec GetUtterancesView
$creadPrec :: ReadPrec GetUtterancesView
readList :: ReadS [GetUtterancesView]
$creadList :: ReadS [GetUtterancesView]
readsPrec :: Int -> ReadS GetUtterancesView
$creadsPrec :: Int -> ReadS GetUtterancesView
Prelude.Read, Int -> GetUtterancesView -> ShowS
[GetUtterancesView] -> ShowS
GetUtterancesView -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUtterancesView] -> ShowS
$cshowList :: [GetUtterancesView] -> ShowS
show :: GetUtterancesView -> String
$cshow :: GetUtterancesView -> String
showsPrec :: Int -> GetUtterancesView -> ShowS
$cshowsPrec :: Int -> GetUtterancesView -> ShowS
Prelude.Show, forall x. Rep GetUtterancesView x -> GetUtterancesView
forall x. GetUtterancesView -> Rep GetUtterancesView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUtterancesView x -> GetUtterancesView
$cfrom :: forall x. GetUtterancesView -> Rep GetUtterancesView x
Prelude.Generic)

-- |
-- Create a value of 'GetUtterancesView' 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:
--
-- 'botName', 'getUtterancesView_botName' - The name of the bot for which utterance information should be returned.
--
-- 'botVersions', 'getUtterancesView_botVersions' - An array of bot versions for which utterance information should be
-- returned. The limit is 5 versions per request.
--
-- 'statusType', 'getUtterancesView_statusType' - To return utterances that were recognized and handled, use @Detected@.
-- To return utterances that were not recognized, use @Missed@.
newGetUtterancesView ::
  -- | 'botName'
  Prelude.Text ->
  -- | 'botVersions'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'statusType'
  StatusType ->
  GetUtterancesView
newGetUtterancesView :: Text -> NonEmpty Text -> StatusType -> GetUtterancesView
newGetUtterancesView
  Text
pBotName_
  NonEmpty Text
pBotVersions_
  StatusType
pStatusType_ =
    GetUtterancesView'
      { $sel:botName:GetUtterancesView' :: Text
botName = Text
pBotName_,
        $sel:botVersions:GetUtterancesView' :: NonEmpty Text
botVersions = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pBotVersions_,
        $sel:statusType:GetUtterancesView' :: StatusType
statusType = StatusType
pStatusType_
      }

-- | The name of the bot for which utterance information should be returned.
getUtterancesView_botName :: Lens.Lens' GetUtterancesView Prelude.Text
getUtterancesView_botName :: Lens' GetUtterancesView Text
getUtterancesView_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUtterancesView' {Text
botName :: Text
$sel:botName:GetUtterancesView' :: GetUtterancesView -> Text
botName} -> Text
botName) (\s :: GetUtterancesView
s@GetUtterancesView' {} Text
a -> GetUtterancesView
s {$sel:botName:GetUtterancesView' :: Text
botName = Text
a} :: GetUtterancesView)

-- | An array of bot versions for which utterance information should be
-- returned. The limit is 5 versions per request.
getUtterancesView_botVersions :: Lens.Lens' GetUtterancesView (Prelude.NonEmpty Prelude.Text)
getUtterancesView_botVersions :: Lens' GetUtterancesView (NonEmpty Text)
getUtterancesView_botVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUtterancesView' {NonEmpty Text
botVersions :: NonEmpty Text
$sel:botVersions:GetUtterancesView' :: GetUtterancesView -> NonEmpty Text
botVersions} -> NonEmpty Text
botVersions) (\s :: GetUtterancesView
s@GetUtterancesView' {} NonEmpty Text
a -> GetUtterancesView
s {$sel:botVersions:GetUtterancesView' :: NonEmpty Text
botVersions = NonEmpty Text
a} :: GetUtterancesView) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | To return utterances that were recognized and handled, use @Detected@.
-- To return utterances that were not recognized, use @Missed@.
getUtterancesView_statusType :: Lens.Lens' GetUtterancesView StatusType
getUtterancesView_statusType :: Lens' GetUtterancesView StatusType
getUtterancesView_statusType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUtterancesView' {StatusType
statusType :: StatusType
$sel:statusType:GetUtterancesView' :: GetUtterancesView -> StatusType
statusType} -> StatusType
statusType) (\s :: GetUtterancesView
s@GetUtterancesView' {} StatusType
a -> GetUtterancesView
s {$sel:statusType:GetUtterancesView' :: StatusType
statusType = StatusType
a} :: GetUtterancesView)

instance Core.AWSRequest GetUtterancesView where
  type
    AWSResponse GetUtterancesView =
      GetUtterancesViewResponse
  request :: (Service -> Service)
-> GetUtterancesView -> Request GetUtterancesView
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 GetUtterancesView
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetUtterancesView)))
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 [UtteranceList] -> Int -> GetUtterancesViewResponse
GetUtterancesViewResponse'
            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
"botName")
            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
"utterances" 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 GetUtterancesView where
  hashWithSalt :: Int -> GetUtterancesView -> Int
hashWithSalt Int
_salt GetUtterancesView' {NonEmpty Text
Text
StatusType
statusType :: StatusType
botVersions :: NonEmpty Text
botName :: Text
$sel:statusType:GetUtterancesView' :: GetUtterancesView -> StatusType
$sel:botVersions:GetUtterancesView' :: GetUtterancesView -> NonEmpty Text
$sel:botName:GetUtterancesView' :: GetUtterancesView -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
botVersions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StatusType
statusType

instance Prelude.NFData GetUtterancesView where
  rnf :: GetUtterancesView -> ()
rnf GetUtterancesView' {NonEmpty Text
Text
StatusType
statusType :: StatusType
botVersions :: NonEmpty Text
botName :: Text
$sel:statusType:GetUtterancesView' :: GetUtterancesView -> StatusType
$sel:botVersions:GetUtterancesView' :: GetUtterancesView -> NonEmpty Text
$sel:botName:GetUtterancesView' :: GetUtterancesView -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
botVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StatusType
statusType

instance Data.ToHeaders GetUtterancesView where
  toHeaders :: GetUtterancesView -> 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 GetUtterancesView where
  toPath :: GetUtterancesView -> ByteString
toPath GetUtterancesView' {NonEmpty Text
Text
StatusType
statusType :: StatusType
botVersions :: NonEmpty Text
botName :: Text
$sel:statusType:GetUtterancesView' :: GetUtterancesView -> StatusType
$sel:botVersions:GetUtterancesView' :: GetUtterancesView -> NonEmpty Text
$sel:botName:GetUtterancesView' :: GetUtterancesView -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/bots/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
botName, ByteString
"/utterances"]

instance Data.ToQuery GetUtterancesView where
  toQuery :: GetUtterancesView -> QueryString
toQuery GetUtterancesView' {NonEmpty Text
Text
StatusType
statusType :: StatusType
botVersions :: NonEmpty Text
botName :: Text
$sel:statusType:GetUtterancesView' :: GetUtterancesView -> StatusType
$sel:botVersions:GetUtterancesView' :: GetUtterancesView -> NonEmpty Text
$sel:botName:GetUtterancesView' :: GetUtterancesView -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"bot_versions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" NonEmpty Text
botVersions,
        ByteString
"status_type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: StatusType
statusType,
        QueryString
"view=aggregation"
      ]

-- | /See:/ 'newGetUtterancesViewResponse' smart constructor.
data GetUtterancesViewResponse = GetUtterancesViewResponse'
  { -- | The name of the bot for which utterance information was returned.
    GetUtterancesViewResponse -> Maybe Text
botName :: Prelude.Maybe Prelude.Text,
    -- | An array of UtteranceList objects, each containing a list of
    -- UtteranceData objects describing the utterances that were processed by
    -- your bot. The response contains a maximum of 100 @UtteranceData@ objects
    -- for each version. Amazon Lex returns the most frequent utterances
    -- received by the bot in the last 15 days.
    GetUtterancesViewResponse -> Maybe [UtteranceList]
utterances :: Prelude.Maybe [UtteranceList],
    -- | The response's http status code.
    GetUtterancesViewResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetUtterancesViewResponse -> GetUtterancesViewResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUtterancesViewResponse -> GetUtterancesViewResponse -> Bool
$c/= :: GetUtterancesViewResponse -> GetUtterancesViewResponse -> Bool
== :: GetUtterancesViewResponse -> GetUtterancesViewResponse -> Bool
$c== :: GetUtterancesViewResponse -> GetUtterancesViewResponse -> Bool
Prelude.Eq, ReadPrec [GetUtterancesViewResponse]
ReadPrec GetUtterancesViewResponse
Int -> ReadS GetUtterancesViewResponse
ReadS [GetUtterancesViewResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUtterancesViewResponse]
$creadListPrec :: ReadPrec [GetUtterancesViewResponse]
readPrec :: ReadPrec GetUtterancesViewResponse
$creadPrec :: ReadPrec GetUtterancesViewResponse
readList :: ReadS [GetUtterancesViewResponse]
$creadList :: ReadS [GetUtterancesViewResponse]
readsPrec :: Int -> ReadS GetUtterancesViewResponse
$creadsPrec :: Int -> ReadS GetUtterancesViewResponse
Prelude.Read, Int -> GetUtterancesViewResponse -> ShowS
[GetUtterancesViewResponse] -> ShowS
GetUtterancesViewResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUtterancesViewResponse] -> ShowS
$cshowList :: [GetUtterancesViewResponse] -> ShowS
show :: GetUtterancesViewResponse -> String
$cshow :: GetUtterancesViewResponse -> String
showsPrec :: Int -> GetUtterancesViewResponse -> ShowS
$cshowsPrec :: Int -> GetUtterancesViewResponse -> ShowS
Prelude.Show, forall x.
Rep GetUtterancesViewResponse x -> GetUtterancesViewResponse
forall x.
GetUtterancesViewResponse -> Rep GetUtterancesViewResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetUtterancesViewResponse x -> GetUtterancesViewResponse
$cfrom :: forall x.
GetUtterancesViewResponse -> Rep GetUtterancesViewResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetUtterancesViewResponse' 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:
--
-- 'botName', 'getUtterancesViewResponse_botName' - The name of the bot for which utterance information was returned.
--
-- 'utterances', 'getUtterancesViewResponse_utterances' - An array of UtteranceList objects, each containing a list of
-- UtteranceData objects describing the utterances that were processed by
-- your bot. The response contains a maximum of 100 @UtteranceData@ objects
-- for each version. Amazon Lex returns the most frequent utterances
-- received by the bot in the last 15 days.
--
-- 'httpStatus', 'getUtterancesViewResponse_httpStatus' - The response's http status code.
newGetUtterancesViewResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetUtterancesViewResponse
newGetUtterancesViewResponse :: Int -> GetUtterancesViewResponse
newGetUtterancesViewResponse Int
pHttpStatus_ =
  GetUtterancesViewResponse'
    { $sel:botName:GetUtterancesViewResponse' :: Maybe Text
botName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:utterances:GetUtterancesViewResponse' :: Maybe [UtteranceList]
utterances = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetUtterancesViewResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the bot for which utterance information was returned.
getUtterancesViewResponse_botName :: Lens.Lens' GetUtterancesViewResponse (Prelude.Maybe Prelude.Text)
getUtterancesViewResponse_botName :: Lens' GetUtterancesViewResponse (Maybe Text)
getUtterancesViewResponse_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUtterancesViewResponse' {Maybe Text
botName :: Maybe Text
$sel:botName:GetUtterancesViewResponse' :: GetUtterancesViewResponse -> Maybe Text
botName} -> Maybe Text
botName) (\s :: GetUtterancesViewResponse
s@GetUtterancesViewResponse' {} Maybe Text
a -> GetUtterancesViewResponse
s {$sel:botName:GetUtterancesViewResponse' :: Maybe Text
botName = Maybe Text
a} :: GetUtterancesViewResponse)

-- | An array of UtteranceList objects, each containing a list of
-- UtteranceData objects describing the utterances that were processed by
-- your bot. The response contains a maximum of 100 @UtteranceData@ objects
-- for each version. Amazon Lex returns the most frequent utterances
-- received by the bot in the last 15 days.
getUtterancesViewResponse_utterances :: Lens.Lens' GetUtterancesViewResponse (Prelude.Maybe [UtteranceList])
getUtterancesViewResponse_utterances :: Lens' GetUtterancesViewResponse (Maybe [UtteranceList])
getUtterancesViewResponse_utterances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUtterancesViewResponse' {Maybe [UtteranceList]
utterances :: Maybe [UtteranceList]
$sel:utterances:GetUtterancesViewResponse' :: GetUtterancesViewResponse -> Maybe [UtteranceList]
utterances} -> Maybe [UtteranceList]
utterances) (\s :: GetUtterancesViewResponse
s@GetUtterancesViewResponse' {} Maybe [UtteranceList]
a -> GetUtterancesViewResponse
s {$sel:utterances:GetUtterancesViewResponse' :: Maybe [UtteranceList]
utterances = Maybe [UtteranceList]
a} :: GetUtterancesViewResponse) 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.
getUtterancesViewResponse_httpStatus :: Lens.Lens' GetUtterancesViewResponse Prelude.Int
getUtterancesViewResponse_httpStatus :: Lens' GetUtterancesViewResponse Int
getUtterancesViewResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUtterancesViewResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetUtterancesViewResponse' :: GetUtterancesViewResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetUtterancesViewResponse
s@GetUtterancesViewResponse' {} Int
a -> GetUtterancesViewResponse
s {$sel:httpStatus:GetUtterancesViewResponse' :: Int
httpStatus = Int
a} :: GetUtterancesViewResponse)

instance Prelude.NFData GetUtterancesViewResponse where
  rnf :: GetUtterancesViewResponse -> ()
rnf GetUtterancesViewResponse' {Int
Maybe [UtteranceList]
Maybe Text
httpStatus :: Int
utterances :: Maybe [UtteranceList]
botName :: Maybe Text
$sel:httpStatus:GetUtterancesViewResponse' :: GetUtterancesViewResponse -> Int
$sel:utterances:GetUtterancesViewResponse' :: GetUtterancesViewResponse -> Maybe [UtteranceList]
$sel:botName:GetUtterancesViewResponse' :: GetUtterancesViewResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UtteranceList]
utterances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus