{-# 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.XRay.GetInsightSummaries
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the summaries of all insights in the specified group matching
-- the provided filter values.
module Amazonka.XRay.GetInsightSummaries
  ( -- * Creating a Request
    GetInsightSummaries (..),
    newGetInsightSummaries,

    -- * Request Lenses
    getInsightSummaries_groupARN,
    getInsightSummaries_groupName,
    getInsightSummaries_maxResults,
    getInsightSummaries_nextToken,
    getInsightSummaries_states,
    getInsightSummaries_startTime,
    getInsightSummaries_endTime,

    -- * Destructuring the Response
    GetInsightSummariesResponse (..),
    newGetInsightSummariesResponse,

    -- * Response Lenses
    getInsightSummariesResponse_insightSummaries,
    getInsightSummariesResponse_nextToken,
    getInsightSummariesResponse_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.XRay.Types

-- | /See:/ 'newGetInsightSummaries' smart constructor.
data GetInsightSummaries = GetInsightSummaries'
  { -- | The Amazon Resource Name (ARN) of the group. Required if the GroupName
    -- isn\'t provided.
    GetInsightSummaries -> Maybe Text
groupARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the group. Required if the GroupARN isn\'t provided.
    GetInsightSummaries -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of results to display.
    GetInsightSummaries -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Pagination token.
    GetInsightSummaries -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of insight states.
    GetInsightSummaries -> Maybe [InsightState]
states :: Prelude.Maybe [InsightState],
    -- | The beginning of the time frame in which the insights started. The start
    -- time can\'t be more than 30 days old.
    GetInsightSummaries -> POSIX
startTime :: Data.POSIX,
    -- | The end of the time frame in which the insights ended. The end time
    -- can\'t be more than 30 days old.
    GetInsightSummaries -> POSIX
endTime :: Data.POSIX
  }
  deriving (GetInsightSummaries -> GetInsightSummaries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetInsightSummaries -> GetInsightSummaries -> Bool
$c/= :: GetInsightSummaries -> GetInsightSummaries -> Bool
== :: GetInsightSummaries -> GetInsightSummaries -> Bool
$c== :: GetInsightSummaries -> GetInsightSummaries -> Bool
Prelude.Eq, ReadPrec [GetInsightSummaries]
ReadPrec GetInsightSummaries
Int -> ReadS GetInsightSummaries
ReadS [GetInsightSummaries]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetInsightSummaries]
$creadListPrec :: ReadPrec [GetInsightSummaries]
readPrec :: ReadPrec GetInsightSummaries
$creadPrec :: ReadPrec GetInsightSummaries
readList :: ReadS [GetInsightSummaries]
$creadList :: ReadS [GetInsightSummaries]
readsPrec :: Int -> ReadS GetInsightSummaries
$creadsPrec :: Int -> ReadS GetInsightSummaries
Prelude.Read, Int -> GetInsightSummaries -> ShowS
[GetInsightSummaries] -> ShowS
GetInsightSummaries -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetInsightSummaries] -> ShowS
$cshowList :: [GetInsightSummaries] -> ShowS
show :: GetInsightSummaries -> String
$cshow :: GetInsightSummaries -> String
showsPrec :: Int -> GetInsightSummaries -> ShowS
$cshowsPrec :: Int -> GetInsightSummaries -> ShowS
Prelude.Show, forall x. Rep GetInsightSummaries x -> GetInsightSummaries
forall x. GetInsightSummaries -> Rep GetInsightSummaries x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetInsightSummaries x -> GetInsightSummaries
$cfrom :: forall x. GetInsightSummaries -> Rep GetInsightSummaries x
Prelude.Generic)

-- |
-- Create a value of 'GetInsightSummaries' 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:
--
-- 'groupARN', 'getInsightSummaries_groupARN' - The Amazon Resource Name (ARN) of the group. Required if the GroupName
-- isn\'t provided.
--
-- 'groupName', 'getInsightSummaries_groupName' - The name of the group. Required if the GroupARN isn\'t provided.
--
-- 'maxResults', 'getInsightSummaries_maxResults' - The maximum number of results to display.
--
-- 'nextToken', 'getInsightSummaries_nextToken' - Pagination token.
--
-- 'states', 'getInsightSummaries_states' - The list of insight states.
--
-- 'startTime', 'getInsightSummaries_startTime' - The beginning of the time frame in which the insights started. The start
-- time can\'t be more than 30 days old.
--
-- 'endTime', 'getInsightSummaries_endTime' - The end of the time frame in which the insights ended. The end time
-- can\'t be more than 30 days old.
newGetInsightSummaries ::
  -- | 'startTime'
  Prelude.UTCTime ->
  -- | 'endTime'
  Prelude.UTCTime ->
  GetInsightSummaries
newGetInsightSummaries :: UTCTime -> UTCTime -> GetInsightSummaries
newGetInsightSummaries UTCTime
pStartTime_ UTCTime
pEndTime_ =
  GetInsightSummaries'
    { $sel:groupARN:GetInsightSummaries' :: Maybe Text
groupARN = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:GetInsightSummaries' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetInsightSummaries' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetInsightSummaries' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:states:GetInsightSummaries' :: Maybe [InsightState]
states = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:GetInsightSummaries' :: POSIX
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
      $sel:endTime:GetInsightSummaries' :: POSIX
endTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEndTime_
    }

-- | The Amazon Resource Name (ARN) of the group. Required if the GroupName
-- isn\'t provided.
getInsightSummaries_groupARN :: Lens.Lens' GetInsightSummaries (Prelude.Maybe Prelude.Text)
getInsightSummaries_groupARN :: Lens' GetInsightSummaries (Maybe Text)
getInsightSummaries_groupARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummaries' {Maybe Text
groupARN :: Maybe Text
$sel:groupARN:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
groupARN} -> Maybe Text
groupARN) (\s :: GetInsightSummaries
s@GetInsightSummaries' {} Maybe Text
a -> GetInsightSummaries
s {$sel:groupARN:GetInsightSummaries' :: Maybe Text
groupARN = Maybe Text
a} :: GetInsightSummaries)

-- | The name of the group. Required if the GroupARN isn\'t provided.
getInsightSummaries_groupName :: Lens.Lens' GetInsightSummaries (Prelude.Maybe Prelude.Text)
getInsightSummaries_groupName :: Lens' GetInsightSummaries (Maybe Text)
getInsightSummaries_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummaries' {Maybe Text
groupName :: Maybe Text
$sel:groupName:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
groupName} -> Maybe Text
groupName) (\s :: GetInsightSummaries
s@GetInsightSummaries' {} Maybe Text
a -> GetInsightSummaries
s {$sel:groupName:GetInsightSummaries' :: Maybe Text
groupName = Maybe Text
a} :: GetInsightSummaries)

-- | The maximum number of results to display.
getInsightSummaries_maxResults :: Lens.Lens' GetInsightSummaries (Prelude.Maybe Prelude.Natural)
getInsightSummaries_maxResults :: Lens' GetInsightSummaries (Maybe Natural)
getInsightSummaries_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummaries' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetInsightSummaries' :: GetInsightSummaries -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetInsightSummaries
s@GetInsightSummaries' {} Maybe Natural
a -> GetInsightSummaries
s {$sel:maxResults:GetInsightSummaries' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetInsightSummaries)

-- | Pagination token.
getInsightSummaries_nextToken :: Lens.Lens' GetInsightSummaries (Prelude.Maybe Prelude.Text)
getInsightSummaries_nextToken :: Lens' GetInsightSummaries (Maybe Text)
getInsightSummaries_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummaries' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetInsightSummaries
s@GetInsightSummaries' {} Maybe Text
a -> GetInsightSummaries
s {$sel:nextToken:GetInsightSummaries' :: Maybe Text
nextToken = Maybe Text
a} :: GetInsightSummaries)

-- | The list of insight states.
getInsightSummaries_states :: Lens.Lens' GetInsightSummaries (Prelude.Maybe [InsightState])
getInsightSummaries_states :: Lens' GetInsightSummaries (Maybe [InsightState])
getInsightSummaries_states = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummaries' {Maybe [InsightState]
states :: Maybe [InsightState]
$sel:states:GetInsightSummaries' :: GetInsightSummaries -> Maybe [InsightState]
states} -> Maybe [InsightState]
states) (\s :: GetInsightSummaries
s@GetInsightSummaries' {} Maybe [InsightState]
a -> GetInsightSummaries
s {$sel:states:GetInsightSummaries' :: Maybe [InsightState]
states = Maybe [InsightState]
a} :: GetInsightSummaries) 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 beginning of the time frame in which the insights started. The start
-- time can\'t be more than 30 days old.
getInsightSummaries_startTime :: Lens.Lens' GetInsightSummaries Prelude.UTCTime
getInsightSummaries_startTime :: Lens' GetInsightSummaries UTCTime
getInsightSummaries_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummaries' {POSIX
startTime :: POSIX
$sel:startTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
startTime} -> POSIX
startTime) (\s :: GetInsightSummaries
s@GetInsightSummaries' {} POSIX
a -> GetInsightSummaries
s {$sel:startTime:GetInsightSummaries' :: POSIX
startTime = POSIX
a} :: GetInsightSummaries) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The end of the time frame in which the insights ended. The end time
-- can\'t be more than 30 days old.
getInsightSummaries_endTime :: Lens.Lens' GetInsightSummaries Prelude.UTCTime
getInsightSummaries_endTime :: Lens' GetInsightSummaries UTCTime
getInsightSummaries_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummaries' {POSIX
endTime :: POSIX
$sel:endTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
endTime} -> POSIX
endTime) (\s :: GetInsightSummaries
s@GetInsightSummaries' {} POSIX
a -> GetInsightSummaries
s {$sel:endTime:GetInsightSummaries' :: POSIX
endTime = POSIX
a} :: GetInsightSummaries) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSRequest GetInsightSummaries where
  type
    AWSResponse GetInsightSummaries =
      GetInsightSummariesResponse
  request :: (Service -> Service)
-> GetInsightSummaries -> Request GetInsightSummaries
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 GetInsightSummaries
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetInsightSummaries)))
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 [InsightSummary]
-> Maybe Text -> Int -> GetInsightSummariesResponse
GetInsightSummariesResponse'
            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
"InsightSummaries"
                            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 GetInsightSummaries where
  hashWithSalt :: Int -> GetInsightSummaries -> Int
hashWithSalt Int
_salt GetInsightSummaries' {Maybe Natural
Maybe [InsightState]
Maybe Text
POSIX
endTime :: POSIX
startTime :: POSIX
states :: Maybe [InsightState]
nextToken :: Maybe Text
maxResults :: Maybe Natural
groupName :: Maybe Text
groupARN :: Maybe Text
$sel:endTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
$sel:startTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
$sel:states:GetInsightSummaries' :: GetInsightSummaries -> Maybe [InsightState]
$sel:nextToken:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
$sel:maxResults:GetInsightSummaries' :: GetInsightSummaries -> Maybe Natural
$sel:groupName:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
$sel:groupARN:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupName
      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 [InsightState]
states
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
endTime

instance Prelude.NFData GetInsightSummaries where
  rnf :: GetInsightSummaries -> ()
rnf GetInsightSummaries' {Maybe Natural
Maybe [InsightState]
Maybe Text
POSIX
endTime :: POSIX
startTime :: POSIX
states :: Maybe [InsightState]
nextToken :: Maybe Text
maxResults :: Maybe Natural
groupName :: Maybe Text
groupARN :: Maybe Text
$sel:endTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
$sel:startTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
$sel:states:GetInsightSummaries' :: GetInsightSummaries -> Maybe [InsightState]
$sel:nextToken:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
$sel:maxResults:GetInsightSummaries' :: GetInsightSummaries -> Maybe Natural
$sel:groupName:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
$sel:groupARN:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groupARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groupName
      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 Maybe [InsightState]
states
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
endTime

instance Data.ToHeaders GetInsightSummaries where
  toHeaders :: GetInsightSummaries -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetInsightSummaries where
  toJSON :: GetInsightSummaries -> Value
toJSON GetInsightSummaries' {Maybe Natural
Maybe [InsightState]
Maybe Text
POSIX
endTime :: POSIX
startTime :: POSIX
states :: Maybe [InsightState]
nextToken :: Maybe Text
maxResults :: Maybe Natural
groupName :: Maybe Text
groupARN :: Maybe Text
$sel:endTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
$sel:startTime:GetInsightSummaries' :: GetInsightSummaries -> POSIX
$sel:states:GetInsightSummaries' :: GetInsightSummaries -> Maybe [InsightState]
$sel:nextToken:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
$sel:maxResults:GetInsightSummaries' :: GetInsightSummaries -> Maybe Natural
$sel:groupName:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
$sel:groupARN:GetInsightSummaries' :: GetInsightSummaries -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GroupARN" 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
groupARN,
            (Key
"GroupName" 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
groupName,
            (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
"States" 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 [InsightState]
states,
            forall a. a -> Maybe a
Prelude.Just (Key
"StartTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
startTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"EndTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
endTime)
          ]
      )

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

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

-- | /See:/ 'newGetInsightSummariesResponse' smart constructor.
data GetInsightSummariesResponse = GetInsightSummariesResponse'
  { -- | The summary of each insight within the group matching the provided
    -- filters. The summary contains the InsightID, start and end time, the
    -- root cause service, the root cause and client impact statistics, the top
    -- anomalous services, and the status of the insight.
    GetInsightSummariesResponse -> Maybe [InsightSummary]
insightSummaries :: Prelude.Maybe [InsightSummary],
    -- | Pagination token.
    GetInsightSummariesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetInsightSummariesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetInsightSummariesResponse -> GetInsightSummariesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetInsightSummariesResponse -> GetInsightSummariesResponse -> Bool
$c/= :: GetInsightSummariesResponse -> GetInsightSummariesResponse -> Bool
== :: GetInsightSummariesResponse -> GetInsightSummariesResponse -> Bool
$c== :: GetInsightSummariesResponse -> GetInsightSummariesResponse -> Bool
Prelude.Eq, ReadPrec [GetInsightSummariesResponse]
ReadPrec GetInsightSummariesResponse
Int -> ReadS GetInsightSummariesResponse
ReadS [GetInsightSummariesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetInsightSummariesResponse]
$creadListPrec :: ReadPrec [GetInsightSummariesResponse]
readPrec :: ReadPrec GetInsightSummariesResponse
$creadPrec :: ReadPrec GetInsightSummariesResponse
readList :: ReadS [GetInsightSummariesResponse]
$creadList :: ReadS [GetInsightSummariesResponse]
readsPrec :: Int -> ReadS GetInsightSummariesResponse
$creadsPrec :: Int -> ReadS GetInsightSummariesResponse
Prelude.Read, Int -> GetInsightSummariesResponse -> ShowS
[GetInsightSummariesResponse] -> ShowS
GetInsightSummariesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetInsightSummariesResponse] -> ShowS
$cshowList :: [GetInsightSummariesResponse] -> ShowS
show :: GetInsightSummariesResponse -> String
$cshow :: GetInsightSummariesResponse -> String
showsPrec :: Int -> GetInsightSummariesResponse -> ShowS
$cshowsPrec :: Int -> GetInsightSummariesResponse -> ShowS
Prelude.Show, forall x.
Rep GetInsightSummariesResponse x -> GetInsightSummariesResponse
forall x.
GetInsightSummariesResponse -> Rep GetInsightSummariesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetInsightSummariesResponse x -> GetInsightSummariesResponse
$cfrom :: forall x.
GetInsightSummariesResponse -> Rep GetInsightSummariesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetInsightSummariesResponse' 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:
--
-- 'insightSummaries', 'getInsightSummariesResponse_insightSummaries' - The summary of each insight within the group matching the provided
-- filters. The summary contains the InsightID, start and end time, the
-- root cause service, the root cause and client impact statistics, the top
-- anomalous services, and the status of the insight.
--
-- 'nextToken', 'getInsightSummariesResponse_nextToken' - Pagination token.
--
-- 'httpStatus', 'getInsightSummariesResponse_httpStatus' - The response's http status code.
newGetInsightSummariesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetInsightSummariesResponse
newGetInsightSummariesResponse :: Int -> GetInsightSummariesResponse
newGetInsightSummariesResponse Int
pHttpStatus_ =
  GetInsightSummariesResponse'
    { $sel:insightSummaries:GetInsightSummariesResponse' :: Maybe [InsightSummary]
insightSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetInsightSummariesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetInsightSummariesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The summary of each insight within the group matching the provided
-- filters. The summary contains the InsightID, start and end time, the
-- root cause service, the root cause and client impact statistics, the top
-- anomalous services, and the status of the insight.
getInsightSummariesResponse_insightSummaries :: Lens.Lens' GetInsightSummariesResponse (Prelude.Maybe [InsightSummary])
getInsightSummariesResponse_insightSummaries :: Lens' GetInsightSummariesResponse (Maybe [InsightSummary])
getInsightSummariesResponse_insightSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummariesResponse' {Maybe [InsightSummary]
insightSummaries :: Maybe [InsightSummary]
$sel:insightSummaries:GetInsightSummariesResponse' :: GetInsightSummariesResponse -> Maybe [InsightSummary]
insightSummaries} -> Maybe [InsightSummary]
insightSummaries) (\s :: GetInsightSummariesResponse
s@GetInsightSummariesResponse' {} Maybe [InsightSummary]
a -> GetInsightSummariesResponse
s {$sel:insightSummaries:GetInsightSummariesResponse' :: Maybe [InsightSummary]
insightSummaries = Maybe [InsightSummary]
a} :: GetInsightSummariesResponse) 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

-- | Pagination token.
getInsightSummariesResponse_nextToken :: Lens.Lens' GetInsightSummariesResponse (Prelude.Maybe Prelude.Text)
getInsightSummariesResponse_nextToken :: Lens' GetInsightSummariesResponse (Maybe Text)
getInsightSummariesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSummariesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetInsightSummariesResponse' :: GetInsightSummariesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetInsightSummariesResponse
s@GetInsightSummariesResponse' {} Maybe Text
a -> GetInsightSummariesResponse
s {$sel:nextToken:GetInsightSummariesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetInsightSummariesResponse)

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

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