{-# 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.SSM.GetOpsSummary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- View a summary of operations metadata (OpsData) based on specified
-- filters and aggregators. OpsData can include information about Amazon
-- Web Services Systems Manager OpsCenter operational workitems (OpsItems)
-- as well as information about any Amazon Web Services resource or service
-- configured to report OpsData to Amazon Web Services Systems Manager
-- Explorer.
--
-- This operation returns paginated results.
module Amazonka.SSM.GetOpsSummary
  ( -- * Creating a Request
    GetOpsSummary (..),
    newGetOpsSummary,

    -- * Request Lenses
    getOpsSummary_aggregators,
    getOpsSummary_filters,
    getOpsSummary_maxResults,
    getOpsSummary_nextToken,
    getOpsSummary_resultAttributes,
    getOpsSummary_syncName,

    -- * Destructuring the Response
    GetOpsSummaryResponse (..),
    newGetOpsSummaryResponse,

    -- * Response Lenses
    getOpsSummaryResponse_entities,
    getOpsSummaryResponse_nextToken,
    getOpsSummaryResponse_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.SSM.Types

-- | /See:/ 'newGetOpsSummary' smart constructor.
data GetOpsSummary = GetOpsSummary'
  { -- | Optional aggregators that return counts of OpsData based on one or more
    -- expressions.
    GetOpsSummary -> Maybe (NonEmpty OpsAggregator)
aggregators :: Prelude.Maybe (Prelude.NonEmpty OpsAggregator),
    -- | Optional filters used to scope down the returned OpsData.
    GetOpsSummary -> Maybe (NonEmpty OpsFilter)
filters :: Prelude.Maybe (Prelude.NonEmpty OpsFilter),
    -- | The maximum number of items to return for this call. The call also
    -- returns a token that you can specify in a subsequent call to get the
    -- next set of results.
    GetOpsSummary -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token to start the list. Use this token to get the next set of
    -- results.
    GetOpsSummary -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The OpsData data type to return.
    GetOpsSummary -> Maybe (NonEmpty OpsResultAttribute)
resultAttributes :: Prelude.Maybe (Prelude.NonEmpty OpsResultAttribute),
    -- | Specify the name of a resource data sync to get.
    GetOpsSummary -> Maybe Text
syncName :: Prelude.Maybe Prelude.Text
  }
  deriving (GetOpsSummary -> GetOpsSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetOpsSummary -> GetOpsSummary -> Bool
$c/= :: GetOpsSummary -> GetOpsSummary -> Bool
== :: GetOpsSummary -> GetOpsSummary -> Bool
$c== :: GetOpsSummary -> GetOpsSummary -> Bool
Prelude.Eq, ReadPrec [GetOpsSummary]
ReadPrec GetOpsSummary
Int -> ReadS GetOpsSummary
ReadS [GetOpsSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetOpsSummary]
$creadListPrec :: ReadPrec [GetOpsSummary]
readPrec :: ReadPrec GetOpsSummary
$creadPrec :: ReadPrec GetOpsSummary
readList :: ReadS [GetOpsSummary]
$creadList :: ReadS [GetOpsSummary]
readsPrec :: Int -> ReadS GetOpsSummary
$creadsPrec :: Int -> ReadS GetOpsSummary
Prelude.Read, Int -> GetOpsSummary -> ShowS
[GetOpsSummary] -> ShowS
GetOpsSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetOpsSummary] -> ShowS
$cshowList :: [GetOpsSummary] -> ShowS
show :: GetOpsSummary -> String
$cshow :: GetOpsSummary -> String
showsPrec :: Int -> GetOpsSummary -> ShowS
$cshowsPrec :: Int -> GetOpsSummary -> ShowS
Prelude.Show, forall x. Rep GetOpsSummary x -> GetOpsSummary
forall x. GetOpsSummary -> Rep GetOpsSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetOpsSummary x -> GetOpsSummary
$cfrom :: forall x. GetOpsSummary -> Rep GetOpsSummary x
Prelude.Generic)

-- |
-- Create a value of 'GetOpsSummary' 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:
--
-- 'aggregators', 'getOpsSummary_aggregators' - Optional aggregators that return counts of OpsData based on one or more
-- expressions.
--
-- 'filters', 'getOpsSummary_filters' - Optional filters used to scope down the returned OpsData.
--
-- 'maxResults', 'getOpsSummary_maxResults' - The maximum number of items to return for this call. The call also
-- returns a token that you can specify in a subsequent call to get the
-- next set of results.
--
-- 'nextToken', 'getOpsSummary_nextToken' - A token to start the list. Use this token to get the next set of
-- results.
--
-- 'resultAttributes', 'getOpsSummary_resultAttributes' - The OpsData data type to return.
--
-- 'syncName', 'getOpsSummary_syncName' - Specify the name of a resource data sync to get.
newGetOpsSummary ::
  GetOpsSummary
newGetOpsSummary :: GetOpsSummary
newGetOpsSummary =
  GetOpsSummary'
    { $sel:aggregators:GetOpsSummary' :: Maybe (NonEmpty OpsAggregator)
aggregators = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:GetOpsSummary' :: Maybe (NonEmpty OpsFilter)
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetOpsSummary' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetOpsSummary' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resultAttributes:GetOpsSummary' :: Maybe (NonEmpty OpsResultAttribute)
resultAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:syncName:GetOpsSummary' :: Maybe Text
syncName = forall a. Maybe a
Prelude.Nothing
    }

-- | Optional aggregators that return counts of OpsData based on one or more
-- expressions.
getOpsSummary_aggregators :: Lens.Lens' GetOpsSummary (Prelude.Maybe (Prelude.NonEmpty OpsAggregator))
getOpsSummary_aggregators :: Lens' GetOpsSummary (Maybe (NonEmpty OpsAggregator))
getOpsSummary_aggregators = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummary' {Maybe (NonEmpty OpsAggregator)
aggregators :: Maybe (NonEmpty OpsAggregator)
$sel:aggregators:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsAggregator)
aggregators} -> Maybe (NonEmpty OpsAggregator)
aggregators) (\s :: GetOpsSummary
s@GetOpsSummary' {} Maybe (NonEmpty OpsAggregator)
a -> GetOpsSummary
s {$sel:aggregators:GetOpsSummary' :: Maybe (NonEmpty OpsAggregator)
aggregators = Maybe (NonEmpty OpsAggregator)
a} :: GetOpsSummary) 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

-- | Optional filters used to scope down the returned OpsData.
getOpsSummary_filters :: Lens.Lens' GetOpsSummary (Prelude.Maybe (Prelude.NonEmpty OpsFilter))
getOpsSummary_filters :: Lens' GetOpsSummary (Maybe (NonEmpty OpsFilter))
getOpsSummary_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummary' {Maybe (NonEmpty OpsFilter)
filters :: Maybe (NonEmpty OpsFilter)
$sel:filters:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsFilter)
filters} -> Maybe (NonEmpty OpsFilter)
filters) (\s :: GetOpsSummary
s@GetOpsSummary' {} Maybe (NonEmpty OpsFilter)
a -> GetOpsSummary
s {$sel:filters:GetOpsSummary' :: Maybe (NonEmpty OpsFilter)
filters = Maybe (NonEmpty OpsFilter)
a} :: GetOpsSummary) 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 maximum number of items to return for this call. The call also
-- returns a token that you can specify in a subsequent call to get the
-- next set of results.
getOpsSummary_maxResults :: Lens.Lens' GetOpsSummary (Prelude.Maybe Prelude.Natural)
getOpsSummary_maxResults :: Lens' GetOpsSummary (Maybe Natural)
getOpsSummary_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummary' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetOpsSummary' :: GetOpsSummary -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetOpsSummary
s@GetOpsSummary' {} Maybe Natural
a -> GetOpsSummary
s {$sel:maxResults:GetOpsSummary' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetOpsSummary)

-- | A token to start the list. Use this token to get the next set of
-- results.
getOpsSummary_nextToken :: Lens.Lens' GetOpsSummary (Prelude.Maybe Prelude.Text)
getOpsSummary_nextToken :: Lens' GetOpsSummary (Maybe Text)
getOpsSummary_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummary' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetOpsSummary' :: GetOpsSummary -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetOpsSummary
s@GetOpsSummary' {} Maybe Text
a -> GetOpsSummary
s {$sel:nextToken:GetOpsSummary' :: Maybe Text
nextToken = Maybe Text
a} :: GetOpsSummary)

-- | The OpsData data type to return.
getOpsSummary_resultAttributes :: Lens.Lens' GetOpsSummary (Prelude.Maybe (Prelude.NonEmpty OpsResultAttribute))
getOpsSummary_resultAttributes :: Lens' GetOpsSummary (Maybe (NonEmpty OpsResultAttribute))
getOpsSummary_resultAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummary' {Maybe (NonEmpty OpsResultAttribute)
resultAttributes :: Maybe (NonEmpty OpsResultAttribute)
$sel:resultAttributes:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsResultAttribute)
resultAttributes} -> Maybe (NonEmpty OpsResultAttribute)
resultAttributes) (\s :: GetOpsSummary
s@GetOpsSummary' {} Maybe (NonEmpty OpsResultAttribute)
a -> GetOpsSummary
s {$sel:resultAttributes:GetOpsSummary' :: Maybe (NonEmpty OpsResultAttribute)
resultAttributes = Maybe (NonEmpty OpsResultAttribute)
a} :: GetOpsSummary) 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

-- | Specify the name of a resource data sync to get.
getOpsSummary_syncName :: Lens.Lens' GetOpsSummary (Prelude.Maybe Prelude.Text)
getOpsSummary_syncName :: Lens' GetOpsSummary (Maybe Text)
getOpsSummary_syncName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummary' {Maybe Text
syncName :: Maybe Text
$sel:syncName:GetOpsSummary' :: GetOpsSummary -> Maybe Text
syncName} -> Maybe Text
syncName) (\s :: GetOpsSummary
s@GetOpsSummary' {} Maybe Text
a -> GetOpsSummary
s {$sel:syncName:GetOpsSummary' :: Maybe Text
syncName = Maybe Text
a} :: GetOpsSummary)

instance Core.AWSPager GetOpsSummary where
  page :: GetOpsSummary -> AWSResponse GetOpsSummary -> Maybe GetOpsSummary
page GetOpsSummary
rq AWSResponse GetOpsSummary
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetOpsSummary
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetOpsSummaryResponse (Maybe Text)
getOpsSummaryResponse_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 GetOpsSummary
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetOpsSummaryResponse (Maybe [OpsEntity])
getOpsSummaryResponse_entities
            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.$ GetOpsSummary
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetOpsSummary (Maybe Text)
getOpsSummary_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetOpsSummary
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetOpsSummaryResponse (Maybe Text)
getOpsSummaryResponse_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 GetOpsSummary where
  type
    AWSResponse GetOpsSummary =
      GetOpsSummaryResponse
  request :: (Service -> Service) -> GetOpsSummary -> Request GetOpsSummary
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 GetOpsSummary
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetOpsSummary)))
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 [OpsEntity] -> Maybe Text -> Int -> GetOpsSummaryResponse
GetOpsSummaryResponse'
            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
"Entities" 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 GetOpsSummary where
  hashWithSalt :: Int -> GetOpsSummary -> Int
hashWithSalt Int
_salt GetOpsSummary' {Maybe Natural
Maybe (NonEmpty OpsFilter)
Maybe (NonEmpty OpsAggregator)
Maybe (NonEmpty OpsResultAttribute)
Maybe Text
syncName :: Maybe Text
resultAttributes :: Maybe (NonEmpty OpsResultAttribute)
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty OpsFilter)
aggregators :: Maybe (NonEmpty OpsAggregator)
$sel:syncName:GetOpsSummary' :: GetOpsSummary -> Maybe Text
$sel:resultAttributes:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsResultAttribute)
$sel:nextToken:GetOpsSummary' :: GetOpsSummary -> Maybe Text
$sel:maxResults:GetOpsSummary' :: GetOpsSummary -> Maybe Natural
$sel:filters:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsFilter)
$sel:aggregators:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsAggregator)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty OpsAggregator)
aggregators
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty OpsFilter)
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` Maybe (NonEmpty OpsResultAttribute)
resultAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
syncName

instance Prelude.NFData GetOpsSummary where
  rnf :: GetOpsSummary -> ()
rnf GetOpsSummary' {Maybe Natural
Maybe (NonEmpty OpsFilter)
Maybe (NonEmpty OpsAggregator)
Maybe (NonEmpty OpsResultAttribute)
Maybe Text
syncName :: Maybe Text
resultAttributes :: Maybe (NonEmpty OpsResultAttribute)
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty OpsFilter)
aggregators :: Maybe (NonEmpty OpsAggregator)
$sel:syncName:GetOpsSummary' :: GetOpsSummary -> Maybe Text
$sel:resultAttributes:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsResultAttribute)
$sel:nextToken:GetOpsSummary' :: GetOpsSummary -> Maybe Text
$sel:maxResults:GetOpsSummary' :: GetOpsSummary -> Maybe Natural
$sel:filters:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsFilter)
$sel:aggregators:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsAggregator)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty OpsAggregator)
aggregators
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty OpsFilter)
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 Maybe (NonEmpty OpsResultAttribute)
resultAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
syncName

instance Data.ToHeaders GetOpsSummary where
  toHeaders :: GetOpsSummary -> 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
"AmazonSSM.GetOpsSummary" :: 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 GetOpsSummary where
  toJSON :: GetOpsSummary -> Value
toJSON GetOpsSummary' {Maybe Natural
Maybe (NonEmpty OpsFilter)
Maybe (NonEmpty OpsAggregator)
Maybe (NonEmpty OpsResultAttribute)
Maybe Text
syncName :: Maybe Text
resultAttributes :: Maybe (NonEmpty OpsResultAttribute)
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty OpsFilter)
aggregators :: Maybe (NonEmpty OpsAggregator)
$sel:syncName:GetOpsSummary' :: GetOpsSummary -> Maybe Text
$sel:resultAttributes:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsResultAttribute)
$sel:nextToken:GetOpsSummary' :: GetOpsSummary -> Maybe Text
$sel:maxResults:GetOpsSummary' :: GetOpsSummary -> Maybe Natural
$sel:filters:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsFilter)
$sel:aggregators:GetOpsSummary' :: GetOpsSummary -> Maybe (NonEmpty OpsAggregator)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Aggregators" 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 (NonEmpty OpsAggregator)
aggregators,
            (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 (NonEmpty OpsFilter)
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,
            (Key
"ResultAttributes" 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 (NonEmpty OpsResultAttribute)
resultAttributes,
            (Key
"SyncName" 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
syncName
          ]
      )

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

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

-- | /See:/ 'newGetOpsSummaryResponse' smart constructor.
data GetOpsSummaryResponse = GetOpsSummaryResponse'
  { -- | The list of aggregated details and filtered OpsData.
    GetOpsSummaryResponse -> Maybe [OpsEntity]
entities :: Prelude.Maybe [OpsEntity],
    -- | The token for the next set of items to return. Use this token to get the
    -- next set of results.
    GetOpsSummaryResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetOpsSummaryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetOpsSummaryResponse -> GetOpsSummaryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetOpsSummaryResponse -> GetOpsSummaryResponse -> Bool
$c/= :: GetOpsSummaryResponse -> GetOpsSummaryResponse -> Bool
== :: GetOpsSummaryResponse -> GetOpsSummaryResponse -> Bool
$c== :: GetOpsSummaryResponse -> GetOpsSummaryResponse -> Bool
Prelude.Eq, ReadPrec [GetOpsSummaryResponse]
ReadPrec GetOpsSummaryResponse
Int -> ReadS GetOpsSummaryResponse
ReadS [GetOpsSummaryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetOpsSummaryResponse]
$creadListPrec :: ReadPrec [GetOpsSummaryResponse]
readPrec :: ReadPrec GetOpsSummaryResponse
$creadPrec :: ReadPrec GetOpsSummaryResponse
readList :: ReadS [GetOpsSummaryResponse]
$creadList :: ReadS [GetOpsSummaryResponse]
readsPrec :: Int -> ReadS GetOpsSummaryResponse
$creadsPrec :: Int -> ReadS GetOpsSummaryResponse
Prelude.Read, Int -> GetOpsSummaryResponse -> ShowS
[GetOpsSummaryResponse] -> ShowS
GetOpsSummaryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetOpsSummaryResponse] -> ShowS
$cshowList :: [GetOpsSummaryResponse] -> ShowS
show :: GetOpsSummaryResponse -> String
$cshow :: GetOpsSummaryResponse -> String
showsPrec :: Int -> GetOpsSummaryResponse -> ShowS
$cshowsPrec :: Int -> GetOpsSummaryResponse -> ShowS
Prelude.Show, forall x. Rep GetOpsSummaryResponse x -> GetOpsSummaryResponse
forall x. GetOpsSummaryResponse -> Rep GetOpsSummaryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetOpsSummaryResponse x -> GetOpsSummaryResponse
$cfrom :: forall x. GetOpsSummaryResponse -> Rep GetOpsSummaryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetOpsSummaryResponse' 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:
--
-- 'entities', 'getOpsSummaryResponse_entities' - The list of aggregated details and filtered OpsData.
--
-- 'nextToken', 'getOpsSummaryResponse_nextToken' - The token for the next set of items to return. Use this token to get the
-- next set of results.
--
-- 'httpStatus', 'getOpsSummaryResponse_httpStatus' - The response's http status code.
newGetOpsSummaryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetOpsSummaryResponse
newGetOpsSummaryResponse :: Int -> GetOpsSummaryResponse
newGetOpsSummaryResponse Int
pHttpStatus_ =
  GetOpsSummaryResponse'
    { $sel:entities:GetOpsSummaryResponse' :: Maybe [OpsEntity]
entities = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetOpsSummaryResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetOpsSummaryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of aggregated details and filtered OpsData.
getOpsSummaryResponse_entities :: Lens.Lens' GetOpsSummaryResponse (Prelude.Maybe [OpsEntity])
getOpsSummaryResponse_entities :: Lens' GetOpsSummaryResponse (Maybe [OpsEntity])
getOpsSummaryResponse_entities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummaryResponse' {Maybe [OpsEntity]
entities :: Maybe [OpsEntity]
$sel:entities:GetOpsSummaryResponse' :: GetOpsSummaryResponse -> Maybe [OpsEntity]
entities} -> Maybe [OpsEntity]
entities) (\s :: GetOpsSummaryResponse
s@GetOpsSummaryResponse' {} Maybe [OpsEntity]
a -> GetOpsSummaryResponse
s {$sel:entities:GetOpsSummaryResponse' :: Maybe [OpsEntity]
entities = Maybe [OpsEntity]
a} :: GetOpsSummaryResponse) 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 token for the next set of items to return. Use this token to get the
-- next set of results.
getOpsSummaryResponse_nextToken :: Lens.Lens' GetOpsSummaryResponse (Prelude.Maybe Prelude.Text)
getOpsSummaryResponse_nextToken :: Lens' GetOpsSummaryResponse (Maybe Text)
getOpsSummaryResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetOpsSummaryResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetOpsSummaryResponse' :: GetOpsSummaryResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetOpsSummaryResponse
s@GetOpsSummaryResponse' {} Maybe Text
a -> GetOpsSummaryResponse
s {$sel:nextToken:GetOpsSummaryResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetOpsSummaryResponse)

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

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