{-# 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.Route53AutoNaming.ListOperations
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists operations that match the criteria that you specify.
--
-- This operation returns paginated results.
module Amazonka.Route53AutoNaming.ListOperations
  ( -- * Creating a Request
    ListOperations (..),
    newListOperations,

    -- * Request Lenses
    listOperations_filters,
    listOperations_maxResults,
    listOperations_nextToken,

    -- * Destructuring the Response
    ListOperationsResponse (..),
    newListOperationsResponse,

    -- * Response Lenses
    listOperationsResponse_nextToken,
    listOperationsResponse_operations,
    listOperationsResponse_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.Route53AutoNaming.Types

-- | /See:/ 'newListOperations' smart constructor.
data ListOperations = ListOperations'
  { -- | A complex type that contains specifications for the operations that you
    -- want to list, for example, operations that you started between a
    -- specified start date and end date.
    --
    -- If you specify more than one filter, an operation must match all filters
    -- to be returned by @ListOperations@.
    ListOperations -> Maybe [OperationFilter]
filters :: Prelude.Maybe [OperationFilter],
    -- | The maximum number of items that you want Cloud Map to return in the
    -- response to a @ListOperations@ request. If you don\'t specify a value
    -- for @MaxResults@, Cloud Map returns up to 100 operations.
    ListOperations -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | For the first @ListOperations@ request, omit this value.
    --
    -- If the response contains @NextToken@, submit another @ListOperations@
    -- request to get the next group of results. Specify the value of
    -- @NextToken@ from the previous response in the next request.
    --
    -- Cloud Map gets @MaxResults@ operations and then filters them based on
    -- the specified criteria. It\'s possible that no operations in the first
    -- @MaxResults@ operations matched the specified criteria but that
    -- subsequent groups of @MaxResults@ operations do contain operations that
    -- match the criteria.
    ListOperations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListOperations -> ListOperations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListOperations -> ListOperations -> Bool
$c/= :: ListOperations -> ListOperations -> Bool
== :: ListOperations -> ListOperations -> Bool
$c== :: ListOperations -> ListOperations -> Bool
Prelude.Eq, ReadPrec [ListOperations]
ReadPrec ListOperations
Int -> ReadS ListOperations
ReadS [ListOperations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListOperations]
$creadListPrec :: ReadPrec [ListOperations]
readPrec :: ReadPrec ListOperations
$creadPrec :: ReadPrec ListOperations
readList :: ReadS [ListOperations]
$creadList :: ReadS [ListOperations]
readsPrec :: Int -> ReadS ListOperations
$creadsPrec :: Int -> ReadS ListOperations
Prelude.Read, Int -> ListOperations -> ShowS
[ListOperations] -> ShowS
ListOperations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListOperations] -> ShowS
$cshowList :: [ListOperations] -> ShowS
show :: ListOperations -> String
$cshow :: ListOperations -> String
showsPrec :: Int -> ListOperations -> ShowS
$cshowsPrec :: Int -> ListOperations -> ShowS
Prelude.Show, forall x. Rep ListOperations x -> ListOperations
forall x. ListOperations -> Rep ListOperations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListOperations x -> ListOperations
$cfrom :: forall x. ListOperations -> Rep ListOperations x
Prelude.Generic)

-- |
-- Create a value of 'ListOperations' 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', 'listOperations_filters' - A complex type that contains specifications for the operations that you
-- want to list, for example, operations that you started between a
-- specified start date and end date.
--
-- If you specify more than one filter, an operation must match all filters
-- to be returned by @ListOperations@.
--
-- 'maxResults', 'listOperations_maxResults' - The maximum number of items that you want Cloud Map to return in the
-- response to a @ListOperations@ request. If you don\'t specify a value
-- for @MaxResults@, Cloud Map returns up to 100 operations.
--
-- 'nextToken', 'listOperations_nextToken' - For the first @ListOperations@ request, omit this value.
--
-- If the response contains @NextToken@, submit another @ListOperations@
-- request to get the next group of results. Specify the value of
-- @NextToken@ from the previous response in the next request.
--
-- Cloud Map gets @MaxResults@ operations and then filters them based on
-- the specified criteria. It\'s possible that no operations in the first
-- @MaxResults@ operations matched the specified criteria but that
-- subsequent groups of @MaxResults@ operations do contain operations that
-- match the criteria.
newListOperations ::
  ListOperations
newListOperations :: ListOperations
newListOperations =
  ListOperations'
    { $sel:filters:ListOperations' :: Maybe [OperationFilter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListOperations' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListOperations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | A complex type that contains specifications for the operations that you
-- want to list, for example, operations that you started between a
-- specified start date and end date.
--
-- If you specify more than one filter, an operation must match all filters
-- to be returned by @ListOperations@.
listOperations_filters :: Lens.Lens' ListOperations (Prelude.Maybe [OperationFilter])
listOperations_filters :: Lens' ListOperations (Maybe [OperationFilter])
listOperations_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOperations' {Maybe [OperationFilter]
filters :: Maybe [OperationFilter]
$sel:filters:ListOperations' :: ListOperations -> Maybe [OperationFilter]
filters} -> Maybe [OperationFilter]
filters) (\s :: ListOperations
s@ListOperations' {} Maybe [OperationFilter]
a -> ListOperations
s {$sel:filters:ListOperations' :: Maybe [OperationFilter]
filters = Maybe [OperationFilter]
a} :: ListOperations) 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 that you want Cloud Map to return in the
-- response to a @ListOperations@ request. If you don\'t specify a value
-- for @MaxResults@, Cloud Map returns up to 100 operations.
listOperations_maxResults :: Lens.Lens' ListOperations (Prelude.Maybe Prelude.Natural)
listOperations_maxResults :: Lens' ListOperations (Maybe Natural)
listOperations_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOperations' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListOperations' :: ListOperations -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListOperations
s@ListOperations' {} Maybe Natural
a -> ListOperations
s {$sel:maxResults:ListOperations' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListOperations)

-- | For the first @ListOperations@ request, omit this value.
--
-- If the response contains @NextToken@, submit another @ListOperations@
-- request to get the next group of results. Specify the value of
-- @NextToken@ from the previous response in the next request.
--
-- Cloud Map gets @MaxResults@ operations and then filters them based on
-- the specified criteria. It\'s possible that no operations in the first
-- @MaxResults@ operations matched the specified criteria but that
-- subsequent groups of @MaxResults@ operations do contain operations that
-- match the criteria.
listOperations_nextToken :: Lens.Lens' ListOperations (Prelude.Maybe Prelude.Text)
listOperations_nextToken :: Lens' ListOperations (Maybe Text)
listOperations_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOperations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListOperations' :: ListOperations -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListOperations
s@ListOperations' {} Maybe Text
a -> ListOperations
s {$sel:nextToken:ListOperations' :: Maybe Text
nextToken = Maybe Text
a} :: ListOperations)

instance Core.AWSPager ListOperations where
  page :: ListOperations
-> AWSResponse ListOperations -> Maybe ListOperations
page ListOperations
rq AWSResponse ListOperations
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListOperations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListOperationsResponse (Maybe Text)
listOperationsResponse_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 ListOperations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListOperationsResponse (Maybe [OperationSummary])
listOperationsResponse_operations
            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.$ ListOperations
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListOperations (Maybe Text)
listOperations_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListOperations
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListOperationsResponse (Maybe Text)
listOperationsResponse_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 ListOperations where
  type
    AWSResponse ListOperations =
      ListOperationsResponse
  request :: (Service -> Service) -> ListOperations -> Request ListOperations
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 ListOperations
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListOperations)))
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 [OperationSummary] -> Int -> ListOperationsResponse
ListOperationsResponse'
            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
"Operations" 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 ListOperations where
  hashWithSalt :: Int -> ListOperations -> Int
hashWithSalt Int
_salt ListOperations' {Maybe Natural
Maybe [OperationFilter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [OperationFilter]
$sel:nextToken:ListOperations' :: ListOperations -> Maybe Text
$sel:maxResults:ListOperations' :: ListOperations -> Maybe Natural
$sel:filters:ListOperations' :: ListOperations -> Maybe [OperationFilter]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [OperationFilter]
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

instance Prelude.NFData ListOperations where
  rnf :: ListOperations -> ()
rnf ListOperations' {Maybe Natural
Maybe [OperationFilter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [OperationFilter]
$sel:nextToken:ListOperations' :: ListOperations -> Maybe Text
$sel:maxResults:ListOperations' :: ListOperations -> Maybe Natural
$sel:filters:ListOperations' :: ListOperations -> Maybe [OperationFilter]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [OperationFilter]
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

instance Data.ToHeaders ListOperations where
  toHeaders :: ListOperations -> 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
"Route53AutoNaming_v20170314.ListOperations" ::
                          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 ListOperations where
  toJSON :: ListOperations -> Value
toJSON ListOperations' {Maybe Natural
Maybe [OperationFilter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [OperationFilter]
$sel:nextToken:ListOperations' :: ListOperations -> Maybe Text
$sel:maxResults:ListOperations' :: ListOperations -> Maybe Natural
$sel:filters:ListOperations' :: ListOperations -> Maybe [OperationFilter]
..} =
    [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 [OperationFilter]
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
          ]
      )

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

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

-- | /See:/ 'newListOperationsResponse' smart constructor.
data ListOperationsResponse = ListOperationsResponse'
  { -- | If the response contains @NextToken@, submit another @ListOperations@
    -- request to get the next group of results. Specify the value of
    -- @NextToken@ from the previous response in the next request.
    --
    -- Cloud Map gets @MaxResults@ operations and then filters them based on
    -- the specified criteria. It\'s possible that no operations in the first
    -- @MaxResults@ operations matched the specified criteria but that
    -- subsequent groups of @MaxResults@ operations do contain operations that
    -- match the criteria.
    ListOperationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Summary information about the operations that match the specified
    -- criteria.
    ListOperationsResponse -> Maybe [OperationSummary]
operations :: Prelude.Maybe [OperationSummary],
    -- | The response's http status code.
    ListOperationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListOperationsResponse -> ListOperationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListOperationsResponse -> ListOperationsResponse -> Bool
$c/= :: ListOperationsResponse -> ListOperationsResponse -> Bool
== :: ListOperationsResponse -> ListOperationsResponse -> Bool
$c== :: ListOperationsResponse -> ListOperationsResponse -> Bool
Prelude.Eq, ReadPrec [ListOperationsResponse]
ReadPrec ListOperationsResponse
Int -> ReadS ListOperationsResponse
ReadS [ListOperationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListOperationsResponse]
$creadListPrec :: ReadPrec [ListOperationsResponse]
readPrec :: ReadPrec ListOperationsResponse
$creadPrec :: ReadPrec ListOperationsResponse
readList :: ReadS [ListOperationsResponse]
$creadList :: ReadS [ListOperationsResponse]
readsPrec :: Int -> ReadS ListOperationsResponse
$creadsPrec :: Int -> ReadS ListOperationsResponse
Prelude.Read, Int -> ListOperationsResponse -> ShowS
[ListOperationsResponse] -> ShowS
ListOperationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListOperationsResponse] -> ShowS
$cshowList :: [ListOperationsResponse] -> ShowS
show :: ListOperationsResponse -> String
$cshow :: ListOperationsResponse -> String
showsPrec :: Int -> ListOperationsResponse -> ShowS
$cshowsPrec :: Int -> ListOperationsResponse -> ShowS
Prelude.Show, forall x. Rep ListOperationsResponse x -> ListOperationsResponse
forall x. ListOperationsResponse -> Rep ListOperationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListOperationsResponse x -> ListOperationsResponse
$cfrom :: forall x. ListOperationsResponse -> Rep ListOperationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListOperationsResponse' 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', 'listOperationsResponse_nextToken' - If the response contains @NextToken@, submit another @ListOperations@
-- request to get the next group of results. Specify the value of
-- @NextToken@ from the previous response in the next request.
--
-- Cloud Map gets @MaxResults@ operations and then filters them based on
-- the specified criteria. It\'s possible that no operations in the first
-- @MaxResults@ operations matched the specified criteria but that
-- subsequent groups of @MaxResults@ operations do contain operations that
-- match the criteria.
--
-- 'operations', 'listOperationsResponse_operations' - Summary information about the operations that match the specified
-- criteria.
--
-- 'httpStatus', 'listOperationsResponse_httpStatus' - The response's http status code.
newListOperationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListOperationsResponse
newListOperationsResponse :: Int -> ListOperationsResponse
newListOperationsResponse Int
pHttpStatus_ =
  ListOperationsResponse'
    { $sel:nextToken:ListOperationsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:operations:ListOperationsResponse' :: Maybe [OperationSummary]
operations = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListOperationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the response contains @NextToken@, submit another @ListOperations@
-- request to get the next group of results. Specify the value of
-- @NextToken@ from the previous response in the next request.
--
-- Cloud Map gets @MaxResults@ operations and then filters them based on
-- the specified criteria. It\'s possible that no operations in the first
-- @MaxResults@ operations matched the specified criteria but that
-- subsequent groups of @MaxResults@ operations do contain operations that
-- match the criteria.
listOperationsResponse_nextToken :: Lens.Lens' ListOperationsResponse (Prelude.Maybe Prelude.Text)
listOperationsResponse_nextToken :: Lens' ListOperationsResponse (Maybe Text)
listOperationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOperationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListOperationsResponse' :: ListOperationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListOperationsResponse
s@ListOperationsResponse' {} Maybe Text
a -> ListOperationsResponse
s {$sel:nextToken:ListOperationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListOperationsResponse)

-- | Summary information about the operations that match the specified
-- criteria.
listOperationsResponse_operations :: Lens.Lens' ListOperationsResponse (Prelude.Maybe [OperationSummary])
listOperationsResponse_operations :: Lens' ListOperationsResponse (Maybe [OperationSummary])
listOperationsResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOperationsResponse' {Maybe [OperationSummary]
operations :: Maybe [OperationSummary]
$sel:operations:ListOperationsResponse' :: ListOperationsResponse -> Maybe [OperationSummary]
operations} -> Maybe [OperationSummary]
operations) (\s :: ListOperationsResponse
s@ListOperationsResponse' {} Maybe [OperationSummary]
a -> ListOperationsResponse
s {$sel:operations:ListOperationsResponse' :: Maybe [OperationSummary]
operations = Maybe [OperationSummary]
a} :: ListOperationsResponse) 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.
listOperationsResponse_httpStatus :: Lens.Lens' ListOperationsResponse Prelude.Int
listOperationsResponse_httpStatus :: Lens' ListOperationsResponse Int
listOperationsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOperationsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListOperationsResponse' :: ListOperationsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListOperationsResponse
s@ListOperationsResponse' {} Int
a -> ListOperationsResponse
s {$sel:httpStatus:ListOperationsResponse' :: Int
httpStatus = Int
a} :: ListOperationsResponse)

instance Prelude.NFData ListOperationsResponse where
  rnf :: ListOperationsResponse -> ()
rnf ListOperationsResponse' {Int
Maybe [OperationSummary]
Maybe Text
httpStatus :: Int
operations :: Maybe [OperationSummary]
nextToken :: Maybe Text
$sel:httpStatus:ListOperationsResponse' :: ListOperationsResponse -> Int
$sel:operations:ListOperationsResponse' :: ListOperationsResponse -> Maybe [OperationSummary]
$sel:nextToken:ListOperationsResponse' :: ListOperationsResponse -> 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 [OperationSummary]
operations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus