{-# 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.Transcribe.ListCallAnalyticsCategories
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides a list of Call Analytics categories, including all rules that
-- make up each category.
--
-- To get detailed information about a specific Call Analytics category,
-- use the operation.
module Amazonka.Transcribe.ListCallAnalyticsCategories
  ( -- * Creating a Request
    ListCallAnalyticsCategories (..),
    newListCallAnalyticsCategories,

    -- * Request Lenses
    listCallAnalyticsCategories_maxResults,
    listCallAnalyticsCategories_nextToken,

    -- * Destructuring the Response
    ListCallAnalyticsCategoriesResponse (..),
    newListCallAnalyticsCategoriesResponse,

    -- * Response Lenses
    listCallAnalyticsCategoriesResponse_categories,
    listCallAnalyticsCategoriesResponse_nextToken,
    listCallAnalyticsCategoriesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListCallAnalyticsCategories' smart constructor.
data ListCallAnalyticsCategories = ListCallAnalyticsCategories'
  { -- | The maximum number of Call Analytics categories to return in each page
    -- of results. If there are fewer results than the value that you specify,
    -- only the actual results are returned. If you don\'t specify a value, a
    -- default of 5 is used.
    ListCallAnalyticsCategories -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If your @ListCallAnalyticsCategories@ request returns more results than
    -- can be displayed, @NextToken@ is displayed in the response with an
    -- associated string. To get the next page of results, copy this string and
    -- repeat your request, including @NextToken@ with the value of the copied
    -- string. Repeat as needed to view all your results.
    ListCallAnalyticsCategories -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListCallAnalyticsCategories -> ListCallAnalyticsCategories -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCallAnalyticsCategories -> ListCallAnalyticsCategories -> Bool
$c/= :: ListCallAnalyticsCategories -> ListCallAnalyticsCategories -> Bool
== :: ListCallAnalyticsCategories -> ListCallAnalyticsCategories -> Bool
$c== :: ListCallAnalyticsCategories -> ListCallAnalyticsCategories -> Bool
Prelude.Eq, ReadPrec [ListCallAnalyticsCategories]
ReadPrec ListCallAnalyticsCategories
Int -> ReadS ListCallAnalyticsCategories
ReadS [ListCallAnalyticsCategories]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCallAnalyticsCategories]
$creadListPrec :: ReadPrec [ListCallAnalyticsCategories]
readPrec :: ReadPrec ListCallAnalyticsCategories
$creadPrec :: ReadPrec ListCallAnalyticsCategories
readList :: ReadS [ListCallAnalyticsCategories]
$creadList :: ReadS [ListCallAnalyticsCategories]
readsPrec :: Int -> ReadS ListCallAnalyticsCategories
$creadsPrec :: Int -> ReadS ListCallAnalyticsCategories
Prelude.Read, Int -> ListCallAnalyticsCategories -> ShowS
[ListCallAnalyticsCategories] -> ShowS
ListCallAnalyticsCategories -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCallAnalyticsCategories] -> ShowS
$cshowList :: [ListCallAnalyticsCategories] -> ShowS
show :: ListCallAnalyticsCategories -> String
$cshow :: ListCallAnalyticsCategories -> String
showsPrec :: Int -> ListCallAnalyticsCategories -> ShowS
$cshowsPrec :: Int -> ListCallAnalyticsCategories -> ShowS
Prelude.Show, forall x.
Rep ListCallAnalyticsCategories x -> ListCallAnalyticsCategories
forall x.
ListCallAnalyticsCategories -> Rep ListCallAnalyticsCategories x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCallAnalyticsCategories x -> ListCallAnalyticsCategories
$cfrom :: forall x.
ListCallAnalyticsCategories -> Rep ListCallAnalyticsCategories x
Prelude.Generic)

-- |
-- Create a value of 'ListCallAnalyticsCategories' 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', 'listCallAnalyticsCategories_maxResults' - The maximum number of Call Analytics categories to return in each page
-- of results. If there are fewer results than the value that you specify,
-- only the actual results are returned. If you don\'t specify a value, a
-- default of 5 is used.
--
-- 'nextToken', 'listCallAnalyticsCategories_nextToken' - If your @ListCallAnalyticsCategories@ request returns more results than
-- can be displayed, @NextToken@ is displayed in the response with an
-- associated string. To get the next page of results, copy this string and
-- repeat your request, including @NextToken@ with the value of the copied
-- string. Repeat as needed to view all your results.
newListCallAnalyticsCategories ::
  ListCallAnalyticsCategories
newListCallAnalyticsCategories :: ListCallAnalyticsCategories
newListCallAnalyticsCategories =
  ListCallAnalyticsCategories'
    { $sel:maxResults:ListCallAnalyticsCategories' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCallAnalyticsCategories' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of Call Analytics categories to return in each page
-- of results. If there are fewer results than the value that you specify,
-- only the actual results are returned. If you don\'t specify a value, a
-- default of 5 is used.
listCallAnalyticsCategories_maxResults :: Lens.Lens' ListCallAnalyticsCategories (Prelude.Maybe Prelude.Natural)
listCallAnalyticsCategories_maxResults :: Lens' ListCallAnalyticsCategories (Maybe Natural)
listCallAnalyticsCategories_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCallAnalyticsCategories' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCallAnalyticsCategories
s@ListCallAnalyticsCategories' {} Maybe Natural
a -> ListCallAnalyticsCategories
s {$sel:maxResults:ListCallAnalyticsCategories' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCallAnalyticsCategories)

-- | If your @ListCallAnalyticsCategories@ request returns more results than
-- can be displayed, @NextToken@ is displayed in the response with an
-- associated string. To get the next page of results, copy this string and
-- repeat your request, including @NextToken@ with the value of the copied
-- string. Repeat as needed to view all your results.
listCallAnalyticsCategories_nextToken :: Lens.Lens' ListCallAnalyticsCategories (Prelude.Maybe Prelude.Text)
listCallAnalyticsCategories_nextToken :: Lens' ListCallAnalyticsCategories (Maybe Text)
listCallAnalyticsCategories_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCallAnalyticsCategories' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCallAnalyticsCategories
s@ListCallAnalyticsCategories' {} Maybe Text
a -> ListCallAnalyticsCategories
s {$sel:nextToken:ListCallAnalyticsCategories' :: Maybe Text
nextToken = Maybe Text
a} :: ListCallAnalyticsCategories)

instance Core.AWSRequest ListCallAnalyticsCategories where
  type
    AWSResponse ListCallAnalyticsCategories =
      ListCallAnalyticsCategoriesResponse
  request :: (Service -> Service)
-> ListCallAnalyticsCategories
-> Request ListCallAnalyticsCategories
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 ListCallAnalyticsCategories
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCallAnalyticsCategories)))
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 [CategoryProperties]
-> Maybe Text -> Int -> ListCallAnalyticsCategoriesResponse
ListCallAnalyticsCategoriesResponse'
            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
"Categories" 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
"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 ListCallAnalyticsCategories where
  hashWithSalt :: Int -> ListCallAnalyticsCategories -> Int
hashWithSalt Int
_salt ListCallAnalyticsCategories' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> Maybe Text
$sel:maxResults:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> 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

instance Prelude.NFData ListCallAnalyticsCategories where
  rnf :: ListCallAnalyticsCategories -> ()
rnf ListCallAnalyticsCategories' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> Maybe Text
$sel:maxResults:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> 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

instance Data.ToHeaders ListCallAnalyticsCategories where
  toHeaders :: ListCallAnalyticsCategories -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Transcribe.ListCallAnalyticsCategories" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListCallAnalyticsCategories where
  toJSON :: ListCallAnalyticsCategories -> Value
toJSON ListCallAnalyticsCategories' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> Maybe Text
$sel:maxResults:ListCallAnalyticsCategories' :: ListCallAnalyticsCategories -> 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
          ]
      )

instance Data.ToPath ListCallAnalyticsCategories where
  toPath :: ListCallAnalyticsCategories -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newListCallAnalyticsCategoriesResponse' smart constructor.
data ListCallAnalyticsCategoriesResponse = ListCallAnalyticsCategoriesResponse'
  { -- | Provides detailed information about your Call Analytics categories,
    -- including all the rules associated with each category.
    ListCallAnalyticsCategoriesResponse -> Maybe [CategoryProperties]
categories :: Prelude.Maybe [CategoryProperties],
    -- | If @NextToken@ is present in your response, it indicates that not all
    -- results are displayed. To view the next set of results, copy the string
    -- associated with the @NextToken@ parameter in your results output, then
    -- run your request again including @NextToken@ with the value of the
    -- copied string. Repeat as needed to view all your results.
    ListCallAnalyticsCategoriesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCallAnalyticsCategoriesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCallAnalyticsCategoriesResponse
-> ListCallAnalyticsCategoriesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCallAnalyticsCategoriesResponse
-> ListCallAnalyticsCategoriesResponse -> Bool
$c/= :: ListCallAnalyticsCategoriesResponse
-> ListCallAnalyticsCategoriesResponse -> Bool
== :: ListCallAnalyticsCategoriesResponse
-> ListCallAnalyticsCategoriesResponse -> Bool
$c== :: ListCallAnalyticsCategoriesResponse
-> ListCallAnalyticsCategoriesResponse -> Bool
Prelude.Eq, ReadPrec [ListCallAnalyticsCategoriesResponse]
ReadPrec ListCallAnalyticsCategoriesResponse
Int -> ReadS ListCallAnalyticsCategoriesResponse
ReadS [ListCallAnalyticsCategoriesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCallAnalyticsCategoriesResponse]
$creadListPrec :: ReadPrec [ListCallAnalyticsCategoriesResponse]
readPrec :: ReadPrec ListCallAnalyticsCategoriesResponse
$creadPrec :: ReadPrec ListCallAnalyticsCategoriesResponse
readList :: ReadS [ListCallAnalyticsCategoriesResponse]
$creadList :: ReadS [ListCallAnalyticsCategoriesResponse]
readsPrec :: Int -> ReadS ListCallAnalyticsCategoriesResponse
$creadsPrec :: Int -> ReadS ListCallAnalyticsCategoriesResponse
Prelude.Read, Int -> ListCallAnalyticsCategoriesResponse -> ShowS
[ListCallAnalyticsCategoriesResponse] -> ShowS
ListCallAnalyticsCategoriesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCallAnalyticsCategoriesResponse] -> ShowS
$cshowList :: [ListCallAnalyticsCategoriesResponse] -> ShowS
show :: ListCallAnalyticsCategoriesResponse -> String
$cshow :: ListCallAnalyticsCategoriesResponse -> String
showsPrec :: Int -> ListCallAnalyticsCategoriesResponse -> ShowS
$cshowsPrec :: Int -> ListCallAnalyticsCategoriesResponse -> ShowS
Prelude.Show, forall x.
Rep ListCallAnalyticsCategoriesResponse x
-> ListCallAnalyticsCategoriesResponse
forall x.
ListCallAnalyticsCategoriesResponse
-> Rep ListCallAnalyticsCategoriesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCallAnalyticsCategoriesResponse x
-> ListCallAnalyticsCategoriesResponse
$cfrom :: forall x.
ListCallAnalyticsCategoriesResponse
-> Rep ListCallAnalyticsCategoriesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCallAnalyticsCategoriesResponse' 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:
--
-- 'categories', 'listCallAnalyticsCategoriesResponse_categories' - Provides detailed information about your Call Analytics categories,
-- including all the rules associated with each category.
--
-- 'nextToken', 'listCallAnalyticsCategoriesResponse_nextToken' - If @NextToken@ is present in your response, it indicates that not all
-- results are displayed. To view the next set of results, copy the string
-- associated with the @NextToken@ parameter in your results output, then
-- run your request again including @NextToken@ with the value of the
-- copied string. Repeat as needed to view all your results.
--
-- 'httpStatus', 'listCallAnalyticsCategoriesResponse_httpStatus' - The response's http status code.
newListCallAnalyticsCategoriesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCallAnalyticsCategoriesResponse
newListCallAnalyticsCategoriesResponse :: Int -> ListCallAnalyticsCategoriesResponse
newListCallAnalyticsCategoriesResponse Int
pHttpStatus_ =
  ListCallAnalyticsCategoriesResponse'
    { $sel:categories:ListCallAnalyticsCategoriesResponse' :: Maybe [CategoryProperties]
categories =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCallAnalyticsCategoriesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCallAnalyticsCategoriesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Provides detailed information about your Call Analytics categories,
-- including all the rules associated with each category.
listCallAnalyticsCategoriesResponse_categories :: Lens.Lens' ListCallAnalyticsCategoriesResponse (Prelude.Maybe [CategoryProperties])
listCallAnalyticsCategoriesResponse_categories :: Lens'
  ListCallAnalyticsCategoriesResponse (Maybe [CategoryProperties])
listCallAnalyticsCategoriesResponse_categories = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCallAnalyticsCategoriesResponse' {Maybe [CategoryProperties]
categories :: Maybe [CategoryProperties]
$sel:categories:ListCallAnalyticsCategoriesResponse' :: ListCallAnalyticsCategoriesResponse -> Maybe [CategoryProperties]
categories} -> Maybe [CategoryProperties]
categories) (\s :: ListCallAnalyticsCategoriesResponse
s@ListCallAnalyticsCategoriesResponse' {} Maybe [CategoryProperties]
a -> ListCallAnalyticsCategoriesResponse
s {$sel:categories:ListCallAnalyticsCategoriesResponse' :: Maybe [CategoryProperties]
categories = Maybe [CategoryProperties]
a} :: ListCallAnalyticsCategoriesResponse) 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

-- | If @NextToken@ is present in your response, it indicates that not all
-- results are displayed. To view the next set of results, copy the string
-- associated with the @NextToken@ parameter in your results output, then
-- run your request again including @NextToken@ with the value of the
-- copied string. Repeat as needed to view all your results.
listCallAnalyticsCategoriesResponse_nextToken :: Lens.Lens' ListCallAnalyticsCategoriesResponse (Prelude.Maybe Prelude.Text)
listCallAnalyticsCategoriesResponse_nextToken :: Lens' ListCallAnalyticsCategoriesResponse (Maybe Text)
listCallAnalyticsCategoriesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCallAnalyticsCategoriesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCallAnalyticsCategoriesResponse' :: ListCallAnalyticsCategoriesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCallAnalyticsCategoriesResponse
s@ListCallAnalyticsCategoriesResponse' {} Maybe Text
a -> ListCallAnalyticsCategoriesResponse
s {$sel:nextToken:ListCallAnalyticsCategoriesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCallAnalyticsCategoriesResponse)

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

instance
  Prelude.NFData
    ListCallAnalyticsCategoriesResponse
  where
  rnf :: ListCallAnalyticsCategoriesResponse -> ()
rnf ListCallAnalyticsCategoriesResponse' {Int
Maybe [CategoryProperties]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
categories :: Maybe [CategoryProperties]
$sel:httpStatus:ListCallAnalyticsCategoriesResponse' :: ListCallAnalyticsCategoriesResponse -> Int
$sel:nextToken:ListCallAnalyticsCategoriesResponse' :: ListCallAnalyticsCategoriesResponse -> Maybe Text
$sel:categories:ListCallAnalyticsCategoriesResponse' :: ListCallAnalyticsCategoriesResponse -> Maybe [CategoryProperties]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CategoryProperties]
categories
      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