{-# 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.DevOpsGuru.SearchInsights
-- 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 a list of insights in your Amazon Web Services account. You can
-- specify which insights are returned by their start time, one or more
-- statuses (@ONGOING@ or @CLOSED@), one or more severities (@LOW@,
-- @MEDIUM@, and @HIGH@), and type (@REACTIVE@ or @PROACTIVE@).
--
-- Use the @Filters@ parameter to specify status and severity search
-- parameters. Use the @Type@ parameter to specify @REACTIVE@ or
-- @PROACTIVE@ in your search.
--
-- This operation returns paginated results.
module Amazonka.DevOpsGuru.SearchInsights
  ( -- * Creating a Request
    SearchInsights (..),
    newSearchInsights,

    -- * Request Lenses
    searchInsights_filters,
    searchInsights_maxResults,
    searchInsights_nextToken,
    searchInsights_startTimeRange,
    searchInsights_type,

    -- * Destructuring the Response
    SearchInsightsResponse (..),
    newSearchInsightsResponse,

    -- * Response Lenses
    searchInsightsResponse_nextToken,
    searchInsightsResponse_proactiveInsights,
    searchInsightsResponse_reactiveInsights,
    searchInsightsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newSearchInsights' smart constructor.
data SearchInsights = SearchInsights'
  { -- | A @SearchInsightsFilters@ object that is used to set the severity and
    -- status filters on your insight search.
    SearchInsights -> Maybe SearchInsightsFilters
filters :: Prelude.Maybe SearchInsightsFilters,
    -- | The maximum number of results to return with a single call. To retrieve
    -- the remaining results, make another call with the returned @nextToken@
    -- value.
    SearchInsights -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token to use to retrieve the next page of results for
    -- this operation. If this value is null, it retrieves the first page.
    SearchInsights -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The start of the time range passed in. Returned insights occurred after
    -- this time.
    SearchInsights -> StartTimeRange
startTimeRange :: StartTimeRange,
    -- | The type of insights you are searching for (@REACTIVE@ or @PROACTIVE@).
    SearchInsights -> InsightType
type' :: InsightType
  }
  deriving (SearchInsights -> SearchInsights -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchInsights -> SearchInsights -> Bool
$c/= :: SearchInsights -> SearchInsights -> Bool
== :: SearchInsights -> SearchInsights -> Bool
$c== :: SearchInsights -> SearchInsights -> Bool
Prelude.Eq, ReadPrec [SearchInsights]
ReadPrec SearchInsights
Int -> ReadS SearchInsights
ReadS [SearchInsights]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchInsights]
$creadListPrec :: ReadPrec [SearchInsights]
readPrec :: ReadPrec SearchInsights
$creadPrec :: ReadPrec SearchInsights
readList :: ReadS [SearchInsights]
$creadList :: ReadS [SearchInsights]
readsPrec :: Int -> ReadS SearchInsights
$creadsPrec :: Int -> ReadS SearchInsights
Prelude.Read, Int -> SearchInsights -> ShowS
[SearchInsights] -> ShowS
SearchInsights -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchInsights] -> ShowS
$cshowList :: [SearchInsights] -> ShowS
show :: SearchInsights -> String
$cshow :: SearchInsights -> String
showsPrec :: Int -> SearchInsights -> ShowS
$cshowsPrec :: Int -> SearchInsights -> ShowS
Prelude.Show, forall x. Rep SearchInsights x -> SearchInsights
forall x. SearchInsights -> Rep SearchInsights x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchInsights x -> SearchInsights
$cfrom :: forall x. SearchInsights -> Rep SearchInsights x
Prelude.Generic)

-- |
-- Create a value of 'SearchInsights' 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:
--
-- 'filters', 'searchInsights_filters' - A @SearchInsightsFilters@ object that is used to set the severity and
-- status filters on your insight search.
--
-- 'maxResults', 'searchInsights_maxResults' - The maximum number of results to return with a single call. To retrieve
-- the remaining results, make another call with the returned @nextToken@
-- value.
--
-- 'nextToken', 'searchInsights_nextToken' - The pagination token to use to retrieve the next page of results for
-- this operation. If this value is null, it retrieves the first page.
--
-- 'startTimeRange', 'searchInsights_startTimeRange' - The start of the time range passed in. Returned insights occurred after
-- this time.
--
-- 'type'', 'searchInsights_type' - The type of insights you are searching for (@REACTIVE@ or @PROACTIVE@).
newSearchInsights ::
  -- | 'startTimeRange'
  StartTimeRange ->
  -- | 'type''
  InsightType ->
  SearchInsights
newSearchInsights :: StartTimeRange -> InsightType -> SearchInsights
newSearchInsights StartTimeRange
pStartTimeRange_ InsightType
pType_ =
  SearchInsights'
    { $sel:filters:SearchInsights' :: Maybe SearchInsightsFilters
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:SearchInsights' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:SearchInsights' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startTimeRange:SearchInsights' :: StartTimeRange
startTimeRange = StartTimeRange
pStartTimeRange_,
      $sel:type':SearchInsights' :: InsightType
type' = InsightType
pType_
    }

-- | A @SearchInsightsFilters@ object that is used to set the severity and
-- status filters on your insight search.
searchInsights_filters :: Lens.Lens' SearchInsights (Prelude.Maybe SearchInsightsFilters)
searchInsights_filters :: Lens' SearchInsights (Maybe SearchInsightsFilters)
searchInsights_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsights' {Maybe SearchInsightsFilters
filters :: Maybe SearchInsightsFilters
$sel:filters:SearchInsights' :: SearchInsights -> Maybe SearchInsightsFilters
filters} -> Maybe SearchInsightsFilters
filters) (\s :: SearchInsights
s@SearchInsights' {} Maybe SearchInsightsFilters
a -> SearchInsights
s {$sel:filters:SearchInsights' :: Maybe SearchInsightsFilters
filters = Maybe SearchInsightsFilters
a} :: SearchInsights)

-- | The maximum number of results to return with a single call. To retrieve
-- the remaining results, make another call with the returned @nextToken@
-- value.
searchInsights_maxResults :: Lens.Lens' SearchInsights (Prelude.Maybe Prelude.Natural)
searchInsights_maxResults :: Lens' SearchInsights (Maybe Natural)
searchInsights_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsights' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:SearchInsights' :: SearchInsights -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: SearchInsights
s@SearchInsights' {} Maybe Natural
a -> SearchInsights
s {$sel:maxResults:SearchInsights' :: Maybe Natural
maxResults = Maybe Natural
a} :: SearchInsights)

-- | The pagination token to use to retrieve the next page of results for
-- this operation. If this value is null, it retrieves the first page.
searchInsights_nextToken :: Lens.Lens' SearchInsights (Prelude.Maybe Prelude.Text)
searchInsights_nextToken :: Lens' SearchInsights (Maybe Text)
searchInsights_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsights' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:SearchInsights' :: SearchInsights -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: SearchInsights
s@SearchInsights' {} Maybe Text
a -> SearchInsights
s {$sel:nextToken:SearchInsights' :: Maybe Text
nextToken = Maybe Text
a} :: SearchInsights)

-- | The start of the time range passed in. Returned insights occurred after
-- this time.
searchInsights_startTimeRange :: Lens.Lens' SearchInsights StartTimeRange
searchInsights_startTimeRange :: Lens' SearchInsights StartTimeRange
searchInsights_startTimeRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsights' {StartTimeRange
startTimeRange :: StartTimeRange
$sel:startTimeRange:SearchInsights' :: SearchInsights -> StartTimeRange
startTimeRange} -> StartTimeRange
startTimeRange) (\s :: SearchInsights
s@SearchInsights' {} StartTimeRange
a -> SearchInsights
s {$sel:startTimeRange:SearchInsights' :: StartTimeRange
startTimeRange = StartTimeRange
a} :: SearchInsights)

-- | The type of insights you are searching for (@REACTIVE@ or @PROACTIVE@).
searchInsights_type :: Lens.Lens' SearchInsights InsightType
searchInsights_type :: Lens' SearchInsights InsightType
searchInsights_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsights' {InsightType
type' :: InsightType
$sel:type':SearchInsights' :: SearchInsights -> InsightType
type'} -> InsightType
type') (\s :: SearchInsights
s@SearchInsights' {} InsightType
a -> SearchInsights
s {$sel:type':SearchInsights' :: InsightType
type' = InsightType
a} :: SearchInsights)

instance Core.AWSPager SearchInsights where
  page :: SearchInsights
-> AWSResponse SearchInsights -> Maybe SearchInsights
page SearchInsights
rq AWSResponse SearchInsights
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse SearchInsights
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' SearchInsightsResponse (Maybe Text)
searchInsightsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse SearchInsights
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' SearchInsightsResponse (Maybe [ProactiveInsightSummary])
searchInsightsResponse_proactiveInsights
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse SearchInsights
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' SearchInsightsResponse (Maybe [ReactiveInsightSummary])
searchInsightsResponse_reactiveInsights
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ SearchInsights
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' SearchInsights (Maybe Text)
searchInsights_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse SearchInsights
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' SearchInsightsResponse (Maybe Text)
searchInsightsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest SearchInsights where
  type
    AWSResponse SearchInsights =
      SearchInsightsResponse
  request :: (Service -> Service) -> SearchInsights -> Request SearchInsights
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 SearchInsights
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SearchInsights)))
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 [ProactiveInsightSummary]
-> Maybe [ReactiveInsightSummary]
-> Int
-> SearchInsightsResponse
SearchInsightsResponse'
            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
"NextToken")
            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
"ProactiveInsights"
                            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
"ReactiveInsights"
                            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 SearchInsights where
  hashWithSalt :: Int -> SearchInsights -> Int
hashWithSalt Int
_salt SearchInsights' {Maybe Natural
Maybe Text
Maybe SearchInsightsFilters
InsightType
StartTimeRange
type' :: InsightType
startTimeRange :: StartTimeRange
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe SearchInsightsFilters
$sel:type':SearchInsights' :: SearchInsights -> InsightType
$sel:startTimeRange:SearchInsights' :: SearchInsights -> StartTimeRange
$sel:nextToken:SearchInsights' :: SearchInsights -> Maybe Text
$sel:maxResults:SearchInsights' :: SearchInsights -> Maybe Natural
$sel:filters:SearchInsights' :: SearchInsights -> Maybe SearchInsightsFilters
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SearchInsightsFilters
filters
      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` StartTimeRange
startTimeRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InsightType
type'

instance Prelude.NFData SearchInsights where
  rnf :: SearchInsights -> ()
rnf SearchInsights' {Maybe Natural
Maybe Text
Maybe SearchInsightsFilters
InsightType
StartTimeRange
type' :: InsightType
startTimeRange :: StartTimeRange
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe SearchInsightsFilters
$sel:type':SearchInsights' :: SearchInsights -> InsightType
$sel:startTimeRange:SearchInsights' :: SearchInsights -> StartTimeRange
$sel:nextToken:SearchInsights' :: SearchInsights -> Maybe Text
$sel:maxResults:SearchInsights' :: SearchInsights -> Maybe Natural
$sel:filters:SearchInsights' :: SearchInsights -> Maybe SearchInsightsFilters
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SearchInsightsFilters
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 StartTimeRange
startTimeRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InsightType
type'

instance Data.ToHeaders SearchInsights where
  toHeaders :: SearchInsights -> 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 SearchInsights where
  toJSON :: SearchInsights -> Value
toJSON SearchInsights' {Maybe Natural
Maybe Text
Maybe SearchInsightsFilters
InsightType
StartTimeRange
type' :: InsightType
startTimeRange :: StartTimeRange
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe SearchInsightsFilters
$sel:type':SearchInsights' :: SearchInsights -> InsightType
$sel:startTimeRange:SearchInsights' :: SearchInsights -> StartTimeRange
$sel:nextToken:SearchInsights' :: SearchInsights -> Maybe Text
$sel:maxResults:SearchInsights' :: SearchInsights -> Maybe Natural
$sel:filters:SearchInsights' :: SearchInsights -> Maybe SearchInsightsFilters
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Filters" 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 SearchInsightsFilters
filters,
            (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StartTimeRange" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StartTimeRange
startTimeRange),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InsightType
type')
          ]
      )

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

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

-- | /See:/ 'newSearchInsightsResponse' smart constructor.
data SearchInsightsResponse = SearchInsightsResponse'
  { -- | The pagination token to use to retrieve the next page of results for
    -- this operation. If there are no more pages, this value is null.
    SearchInsightsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The returned proactive insights.
    SearchInsightsResponse -> Maybe [ProactiveInsightSummary]
proactiveInsights :: Prelude.Maybe [ProactiveInsightSummary],
    -- | The returned reactive insights.
    SearchInsightsResponse -> Maybe [ReactiveInsightSummary]
reactiveInsights :: Prelude.Maybe [ReactiveInsightSummary],
    -- | The response's http status code.
    SearchInsightsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SearchInsightsResponse -> SearchInsightsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchInsightsResponse -> SearchInsightsResponse -> Bool
$c/= :: SearchInsightsResponse -> SearchInsightsResponse -> Bool
== :: SearchInsightsResponse -> SearchInsightsResponse -> Bool
$c== :: SearchInsightsResponse -> SearchInsightsResponse -> Bool
Prelude.Eq, ReadPrec [SearchInsightsResponse]
ReadPrec SearchInsightsResponse
Int -> ReadS SearchInsightsResponse
ReadS [SearchInsightsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchInsightsResponse]
$creadListPrec :: ReadPrec [SearchInsightsResponse]
readPrec :: ReadPrec SearchInsightsResponse
$creadPrec :: ReadPrec SearchInsightsResponse
readList :: ReadS [SearchInsightsResponse]
$creadList :: ReadS [SearchInsightsResponse]
readsPrec :: Int -> ReadS SearchInsightsResponse
$creadsPrec :: Int -> ReadS SearchInsightsResponse
Prelude.Read, Int -> SearchInsightsResponse -> ShowS
[SearchInsightsResponse] -> ShowS
SearchInsightsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchInsightsResponse] -> ShowS
$cshowList :: [SearchInsightsResponse] -> ShowS
show :: SearchInsightsResponse -> String
$cshow :: SearchInsightsResponse -> String
showsPrec :: Int -> SearchInsightsResponse -> ShowS
$cshowsPrec :: Int -> SearchInsightsResponse -> ShowS
Prelude.Show, forall x. Rep SearchInsightsResponse x -> SearchInsightsResponse
forall x. SearchInsightsResponse -> Rep SearchInsightsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchInsightsResponse x -> SearchInsightsResponse
$cfrom :: forall x. SearchInsightsResponse -> Rep SearchInsightsResponse x
Prelude.Generic)

-- |
-- Create a value of 'SearchInsightsResponse' 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:
--
-- 'nextToken', 'searchInsightsResponse_nextToken' - The pagination token to use to retrieve the next page of results for
-- this operation. If there are no more pages, this value is null.
--
-- 'proactiveInsights', 'searchInsightsResponse_proactiveInsights' - The returned proactive insights.
--
-- 'reactiveInsights', 'searchInsightsResponse_reactiveInsights' - The returned reactive insights.
--
-- 'httpStatus', 'searchInsightsResponse_httpStatus' - The response's http status code.
newSearchInsightsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SearchInsightsResponse
newSearchInsightsResponse :: Int -> SearchInsightsResponse
newSearchInsightsResponse Int
pHttpStatus_ =
  SearchInsightsResponse'
    { $sel:nextToken:SearchInsightsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:proactiveInsights:SearchInsightsResponse' :: Maybe [ProactiveInsightSummary]
proactiveInsights = forall a. Maybe a
Prelude.Nothing,
      $sel:reactiveInsights:SearchInsightsResponse' :: Maybe [ReactiveInsightSummary]
reactiveInsights = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SearchInsightsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The pagination token to use to retrieve the next page of results for
-- this operation. If there are no more pages, this value is null.
searchInsightsResponse_nextToken :: Lens.Lens' SearchInsightsResponse (Prelude.Maybe Prelude.Text)
searchInsightsResponse_nextToken :: Lens' SearchInsightsResponse (Maybe Text)
searchInsightsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsightsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:SearchInsightsResponse' :: SearchInsightsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: SearchInsightsResponse
s@SearchInsightsResponse' {} Maybe Text
a -> SearchInsightsResponse
s {$sel:nextToken:SearchInsightsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: SearchInsightsResponse)

-- | The returned proactive insights.
searchInsightsResponse_proactiveInsights :: Lens.Lens' SearchInsightsResponse (Prelude.Maybe [ProactiveInsightSummary])
searchInsightsResponse_proactiveInsights :: Lens' SearchInsightsResponse (Maybe [ProactiveInsightSummary])
searchInsightsResponse_proactiveInsights = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsightsResponse' {Maybe [ProactiveInsightSummary]
proactiveInsights :: Maybe [ProactiveInsightSummary]
$sel:proactiveInsights:SearchInsightsResponse' :: SearchInsightsResponse -> Maybe [ProactiveInsightSummary]
proactiveInsights} -> Maybe [ProactiveInsightSummary]
proactiveInsights) (\s :: SearchInsightsResponse
s@SearchInsightsResponse' {} Maybe [ProactiveInsightSummary]
a -> SearchInsightsResponse
s {$sel:proactiveInsights:SearchInsightsResponse' :: Maybe [ProactiveInsightSummary]
proactiveInsights = Maybe [ProactiveInsightSummary]
a} :: SearchInsightsResponse) 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 returned reactive insights.
searchInsightsResponse_reactiveInsights :: Lens.Lens' SearchInsightsResponse (Prelude.Maybe [ReactiveInsightSummary])
searchInsightsResponse_reactiveInsights :: Lens' SearchInsightsResponse (Maybe [ReactiveInsightSummary])
searchInsightsResponse_reactiveInsights = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsightsResponse' {Maybe [ReactiveInsightSummary]
reactiveInsights :: Maybe [ReactiveInsightSummary]
$sel:reactiveInsights:SearchInsightsResponse' :: SearchInsightsResponse -> Maybe [ReactiveInsightSummary]
reactiveInsights} -> Maybe [ReactiveInsightSummary]
reactiveInsights) (\s :: SearchInsightsResponse
s@SearchInsightsResponse' {} Maybe [ReactiveInsightSummary]
a -> SearchInsightsResponse
s {$sel:reactiveInsights:SearchInsightsResponse' :: Maybe [ReactiveInsightSummary]
reactiveInsights = Maybe [ReactiveInsightSummary]
a} :: SearchInsightsResponse) 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.
searchInsightsResponse_httpStatus :: Lens.Lens' SearchInsightsResponse Prelude.Int
searchInsightsResponse_httpStatus :: Lens' SearchInsightsResponse Int
searchInsightsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchInsightsResponse' {Int
httpStatus :: Int
$sel:httpStatus:SearchInsightsResponse' :: SearchInsightsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: SearchInsightsResponse
s@SearchInsightsResponse' {} Int
a -> SearchInsightsResponse
s {$sel:httpStatus:SearchInsightsResponse' :: Int
httpStatus = Int
a} :: SearchInsightsResponse)

instance Prelude.NFData SearchInsightsResponse where
  rnf :: SearchInsightsResponse -> ()
rnf SearchInsightsResponse' {Int
Maybe [ReactiveInsightSummary]
Maybe [ProactiveInsightSummary]
Maybe Text
httpStatus :: Int
reactiveInsights :: Maybe [ReactiveInsightSummary]
proactiveInsights :: Maybe [ProactiveInsightSummary]
nextToken :: Maybe Text
$sel:httpStatus:SearchInsightsResponse' :: SearchInsightsResponse -> Int
$sel:reactiveInsights:SearchInsightsResponse' :: SearchInsightsResponse -> Maybe [ReactiveInsightSummary]
$sel:proactiveInsights:SearchInsightsResponse' :: SearchInsightsResponse -> Maybe [ProactiveInsightSummary]
$sel:nextToken:SearchInsightsResponse' :: SearchInsightsResponse -> Maybe Text
..} =
    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 [ProactiveInsightSummary]
proactiveInsights
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ReactiveInsightSummary]
reactiveInsights
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus