{-# 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.Proton.ListServiceInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List service instances with summary data. This action lists service
-- instances of all services in the Amazon Web Services account.
--
-- This operation returns paginated results.
module Amazonka.Proton.ListServiceInstances
  ( -- * Creating a Request
    ListServiceInstances (..),
    newListServiceInstances,

    -- * Request Lenses
    listServiceInstances_filters,
    listServiceInstances_maxResults,
    listServiceInstances_nextToken,
    listServiceInstances_serviceName,
    listServiceInstances_sortBy,
    listServiceInstances_sortOrder,

    -- * Destructuring the Response
    ListServiceInstancesResponse (..),
    newListServiceInstancesResponse,

    -- * Response Lenses
    listServiceInstancesResponse_nextToken,
    listServiceInstancesResponse_httpStatus,
    listServiceInstancesResponse_serviceInstances,
  )
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 Amazonka.Proton.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListServiceInstances' smart constructor.
data ListServiceInstances = ListServiceInstances'
  { -- | An array of filtering criteria that scope down the result list. By
    -- default, all service instances in the Amazon Web Services account are
    -- returned.
    ListServiceInstances -> Maybe [ListServiceInstancesFilter]
filters :: Prelude.Maybe [ListServiceInstancesFilter],
    -- | The maximum number of service instances to list.
    ListServiceInstances -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token that indicates the location of the next service in the array of
    -- service instances, after the list of service instances that was
    -- previously requested.
    ListServiceInstances -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the service that the service instance belongs to.
    ListServiceInstances -> Maybe Text
serviceName :: Prelude.Maybe Prelude.Text,
    -- | The field that the result list is sorted by.
    --
    -- When you choose to sort by @serviceName@, service instances within each
    -- service are sorted by service instance name.
    --
    -- Default: @serviceName@
    ListServiceInstances -> Maybe ListServiceInstancesSortBy
sortBy :: Prelude.Maybe ListServiceInstancesSortBy,
    -- | Result list sort order.
    --
    -- Default: @ASCENDING@
    ListServiceInstances -> Maybe SortOrder
sortOrder :: Prelude.Maybe SortOrder
  }
  deriving (ListServiceInstances -> ListServiceInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListServiceInstances -> ListServiceInstances -> Bool
$c/= :: ListServiceInstances -> ListServiceInstances -> Bool
== :: ListServiceInstances -> ListServiceInstances -> Bool
$c== :: ListServiceInstances -> ListServiceInstances -> Bool
Prelude.Eq, ReadPrec [ListServiceInstances]
ReadPrec ListServiceInstances
Int -> ReadS ListServiceInstances
ReadS [ListServiceInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListServiceInstances]
$creadListPrec :: ReadPrec [ListServiceInstances]
readPrec :: ReadPrec ListServiceInstances
$creadPrec :: ReadPrec ListServiceInstances
readList :: ReadS [ListServiceInstances]
$creadList :: ReadS [ListServiceInstances]
readsPrec :: Int -> ReadS ListServiceInstances
$creadsPrec :: Int -> ReadS ListServiceInstances
Prelude.Read, Int -> ListServiceInstances -> ShowS
[ListServiceInstances] -> ShowS
ListServiceInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListServiceInstances] -> ShowS
$cshowList :: [ListServiceInstances] -> ShowS
show :: ListServiceInstances -> String
$cshow :: ListServiceInstances -> String
showsPrec :: Int -> ListServiceInstances -> ShowS
$cshowsPrec :: Int -> ListServiceInstances -> ShowS
Prelude.Show, forall x. Rep ListServiceInstances x -> ListServiceInstances
forall x. ListServiceInstances -> Rep ListServiceInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListServiceInstances x -> ListServiceInstances
$cfrom :: forall x. ListServiceInstances -> Rep ListServiceInstances x
Prelude.Generic)

-- |
-- Create a value of 'ListServiceInstances' 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', 'listServiceInstances_filters' - An array of filtering criteria that scope down the result list. By
-- default, all service instances in the Amazon Web Services account are
-- returned.
--
-- 'maxResults', 'listServiceInstances_maxResults' - The maximum number of service instances to list.
--
-- 'nextToken', 'listServiceInstances_nextToken' - A token that indicates the location of the next service in the array of
-- service instances, after the list of service instances that was
-- previously requested.
--
-- 'serviceName', 'listServiceInstances_serviceName' - The name of the service that the service instance belongs to.
--
-- 'sortBy', 'listServiceInstances_sortBy' - The field that the result list is sorted by.
--
-- When you choose to sort by @serviceName@, service instances within each
-- service are sorted by service instance name.
--
-- Default: @serviceName@
--
-- 'sortOrder', 'listServiceInstances_sortOrder' - Result list sort order.
--
-- Default: @ASCENDING@
newListServiceInstances ::
  ListServiceInstances
newListServiceInstances :: ListServiceInstances
newListServiceInstances =
  ListServiceInstances'
    { $sel:filters:ListServiceInstances' :: Maybe [ListServiceInstancesFilter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListServiceInstances' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListServiceInstances' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceName:ListServiceInstances' :: Maybe Text
serviceName = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListServiceInstances' :: Maybe ListServiceInstancesSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:ListServiceInstances' :: Maybe SortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | An array of filtering criteria that scope down the result list. By
-- default, all service instances in the Amazon Web Services account are
-- returned.
listServiceInstances_filters :: Lens.Lens' ListServiceInstances (Prelude.Maybe [ListServiceInstancesFilter])
listServiceInstances_filters :: Lens' ListServiceInstances (Maybe [ListServiceInstancesFilter])
listServiceInstances_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstances' {Maybe [ListServiceInstancesFilter]
filters :: Maybe [ListServiceInstancesFilter]
$sel:filters:ListServiceInstances' :: ListServiceInstances -> Maybe [ListServiceInstancesFilter]
filters} -> Maybe [ListServiceInstancesFilter]
filters) (\s :: ListServiceInstances
s@ListServiceInstances' {} Maybe [ListServiceInstancesFilter]
a -> ListServiceInstances
s {$sel:filters:ListServiceInstances' :: Maybe [ListServiceInstancesFilter]
filters = Maybe [ListServiceInstancesFilter]
a} :: ListServiceInstances) 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 service instances to list.
listServiceInstances_maxResults :: Lens.Lens' ListServiceInstances (Prelude.Maybe Prelude.Natural)
listServiceInstances_maxResults :: Lens' ListServiceInstances (Maybe Natural)
listServiceInstances_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstances' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListServiceInstances' :: ListServiceInstances -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListServiceInstances
s@ListServiceInstances' {} Maybe Natural
a -> ListServiceInstances
s {$sel:maxResults:ListServiceInstances' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListServiceInstances)

-- | A token that indicates the location of the next service in the array of
-- service instances, after the list of service instances that was
-- previously requested.
listServiceInstances_nextToken :: Lens.Lens' ListServiceInstances (Prelude.Maybe Prelude.Text)
listServiceInstances_nextToken :: Lens' ListServiceInstances (Maybe Text)
listServiceInstances_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstances' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListServiceInstances' :: ListServiceInstances -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListServiceInstances
s@ListServiceInstances' {} Maybe Text
a -> ListServiceInstances
s {$sel:nextToken:ListServiceInstances' :: Maybe Text
nextToken = Maybe Text
a} :: ListServiceInstances)

-- | The name of the service that the service instance belongs to.
listServiceInstances_serviceName :: Lens.Lens' ListServiceInstances (Prelude.Maybe Prelude.Text)
listServiceInstances_serviceName :: Lens' ListServiceInstances (Maybe Text)
listServiceInstances_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstances' {Maybe Text
serviceName :: Maybe Text
$sel:serviceName:ListServiceInstances' :: ListServiceInstances -> Maybe Text
serviceName} -> Maybe Text
serviceName) (\s :: ListServiceInstances
s@ListServiceInstances' {} Maybe Text
a -> ListServiceInstances
s {$sel:serviceName:ListServiceInstances' :: Maybe Text
serviceName = Maybe Text
a} :: ListServiceInstances)

-- | The field that the result list is sorted by.
--
-- When you choose to sort by @serviceName@, service instances within each
-- service are sorted by service instance name.
--
-- Default: @serviceName@
listServiceInstances_sortBy :: Lens.Lens' ListServiceInstances (Prelude.Maybe ListServiceInstancesSortBy)
listServiceInstances_sortBy :: Lens' ListServiceInstances (Maybe ListServiceInstancesSortBy)
listServiceInstances_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstances' {Maybe ListServiceInstancesSortBy
sortBy :: Maybe ListServiceInstancesSortBy
$sel:sortBy:ListServiceInstances' :: ListServiceInstances -> Maybe ListServiceInstancesSortBy
sortBy} -> Maybe ListServiceInstancesSortBy
sortBy) (\s :: ListServiceInstances
s@ListServiceInstances' {} Maybe ListServiceInstancesSortBy
a -> ListServiceInstances
s {$sel:sortBy:ListServiceInstances' :: Maybe ListServiceInstancesSortBy
sortBy = Maybe ListServiceInstancesSortBy
a} :: ListServiceInstances)

-- | Result list sort order.
--
-- Default: @ASCENDING@
listServiceInstances_sortOrder :: Lens.Lens' ListServiceInstances (Prelude.Maybe SortOrder)
listServiceInstances_sortOrder :: Lens' ListServiceInstances (Maybe SortOrder)
listServiceInstances_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstances' {Maybe SortOrder
sortOrder :: Maybe SortOrder
$sel:sortOrder:ListServiceInstances' :: ListServiceInstances -> Maybe SortOrder
sortOrder} -> Maybe SortOrder
sortOrder) (\s :: ListServiceInstances
s@ListServiceInstances' {} Maybe SortOrder
a -> ListServiceInstances
s {$sel:sortOrder:ListServiceInstances' :: Maybe SortOrder
sortOrder = Maybe SortOrder
a} :: ListServiceInstances)

instance Core.AWSPager ListServiceInstances where
  page :: ListServiceInstances
-> AWSResponse ListServiceInstances -> Maybe ListServiceInstances
page ListServiceInstances
rq AWSResponse ListServiceInstances
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListServiceInstances
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListServiceInstancesResponse (Maybe Text)
listServiceInstancesResponse_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 ListServiceInstances
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListServiceInstancesResponse [ServiceInstanceSummary]
listServiceInstancesResponse_serviceInstances
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListServiceInstances
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListServiceInstances (Maybe Text)
listServiceInstances_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListServiceInstances
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListServiceInstancesResponse (Maybe Text)
listServiceInstancesResponse_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 ListServiceInstances where
  type
    AWSResponse ListServiceInstances =
      ListServiceInstancesResponse
  request :: (Service -> Service)
-> ListServiceInstances -> Request ListServiceInstances
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 ListServiceInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListServiceInstances)))
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
-> Int -> [ServiceInstanceSummary] -> ListServiceInstancesResponse
ListServiceInstancesResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"serviceInstances"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListServiceInstances where
  hashWithSalt :: Int -> ListServiceInstances -> Int
hashWithSalt Int
_salt ListServiceInstances' {Maybe Natural
Maybe [ListServiceInstancesFilter]
Maybe Text
Maybe ListServiceInstancesSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe ListServiceInstancesSortBy
serviceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [ListServiceInstancesFilter]
$sel:sortOrder:ListServiceInstances' :: ListServiceInstances -> Maybe SortOrder
$sel:sortBy:ListServiceInstances' :: ListServiceInstances -> Maybe ListServiceInstancesSortBy
$sel:serviceName:ListServiceInstances' :: ListServiceInstances -> Maybe Text
$sel:nextToken:ListServiceInstances' :: ListServiceInstances -> Maybe Text
$sel:maxResults:ListServiceInstances' :: ListServiceInstances -> Maybe Natural
$sel:filters:ListServiceInstances' :: ListServiceInstances -> Maybe [ListServiceInstancesFilter]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ListServiceInstancesFilter]
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 Text
serviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ListServiceInstancesSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrder
sortOrder

instance Prelude.NFData ListServiceInstances where
  rnf :: ListServiceInstances -> ()
rnf ListServiceInstances' {Maybe Natural
Maybe [ListServiceInstancesFilter]
Maybe Text
Maybe ListServiceInstancesSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe ListServiceInstancesSortBy
serviceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [ListServiceInstancesFilter]
$sel:sortOrder:ListServiceInstances' :: ListServiceInstances -> Maybe SortOrder
$sel:sortBy:ListServiceInstances' :: ListServiceInstances -> Maybe ListServiceInstancesSortBy
$sel:serviceName:ListServiceInstances' :: ListServiceInstances -> Maybe Text
$sel:nextToken:ListServiceInstances' :: ListServiceInstances -> Maybe Text
$sel:maxResults:ListServiceInstances' :: ListServiceInstances -> Maybe Natural
$sel:filters:ListServiceInstances' :: ListServiceInstances -> Maybe [ListServiceInstancesFilter]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ListServiceInstancesFilter]
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 Text
serviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ListServiceInstancesSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrder
sortOrder

instance Data.ToHeaders ListServiceInstances where
  toHeaders :: ListServiceInstances -> 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
"AwsProton20200720.ListServiceInstances" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListServiceInstances where
  toJSON :: ListServiceInstances -> Value
toJSON ListServiceInstances' {Maybe Natural
Maybe [ListServiceInstancesFilter]
Maybe Text
Maybe ListServiceInstancesSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe ListServiceInstancesSortBy
serviceName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [ListServiceInstancesFilter]
$sel:sortOrder:ListServiceInstances' :: ListServiceInstances -> Maybe SortOrder
$sel:sortBy:ListServiceInstances' :: ListServiceInstances -> Maybe ListServiceInstancesSortBy
$sel:serviceName:ListServiceInstances' :: ListServiceInstances -> Maybe Text
$sel:nextToken:ListServiceInstances' :: ListServiceInstances -> Maybe Text
$sel:maxResults:ListServiceInstances' :: ListServiceInstances -> Maybe Natural
$sel:filters:ListServiceInstances' :: ListServiceInstances -> Maybe [ListServiceInstancesFilter]
..} =
    [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 [ListServiceInstancesFilter]
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
"serviceName" 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
serviceName,
            (Key
"sortBy" 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 ListServiceInstancesSortBy
sortBy,
            (Key
"sortOrder" 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 SortOrder
sortOrder
          ]
      )

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

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

-- | /See:/ 'newListServiceInstancesResponse' smart constructor.
data ListServiceInstancesResponse = ListServiceInstancesResponse'
  { -- | A token that indicates the location of the next service instance in the
    -- array of service instances, after the current requested list of service
    -- instances.
    ListServiceInstancesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListServiceInstancesResponse -> Int
httpStatus :: Prelude.Int,
    -- | An array of service instances with summary data.
    ListServiceInstancesResponse -> [ServiceInstanceSummary]
serviceInstances :: [ServiceInstanceSummary]
  }
  deriving (ListServiceInstancesResponse
-> ListServiceInstancesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListServiceInstancesResponse
-> ListServiceInstancesResponse -> Bool
$c/= :: ListServiceInstancesResponse
-> ListServiceInstancesResponse -> Bool
== :: ListServiceInstancesResponse
-> ListServiceInstancesResponse -> Bool
$c== :: ListServiceInstancesResponse
-> ListServiceInstancesResponse -> Bool
Prelude.Eq, Int -> ListServiceInstancesResponse -> ShowS
[ListServiceInstancesResponse] -> ShowS
ListServiceInstancesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListServiceInstancesResponse] -> ShowS
$cshowList :: [ListServiceInstancesResponse] -> ShowS
show :: ListServiceInstancesResponse -> String
$cshow :: ListServiceInstancesResponse -> String
showsPrec :: Int -> ListServiceInstancesResponse -> ShowS
$cshowsPrec :: Int -> ListServiceInstancesResponse -> ShowS
Prelude.Show, forall x.
Rep ListServiceInstancesResponse x -> ListServiceInstancesResponse
forall x.
ListServiceInstancesResponse -> Rep ListServiceInstancesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListServiceInstancesResponse x -> ListServiceInstancesResponse
$cfrom :: forall x.
ListServiceInstancesResponse -> Rep ListServiceInstancesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListServiceInstancesResponse' 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', 'listServiceInstancesResponse_nextToken' - A token that indicates the location of the next service instance in the
-- array of service instances, after the current requested list of service
-- instances.
--
-- 'httpStatus', 'listServiceInstancesResponse_httpStatus' - The response's http status code.
--
-- 'serviceInstances', 'listServiceInstancesResponse_serviceInstances' - An array of service instances with summary data.
newListServiceInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListServiceInstancesResponse
newListServiceInstancesResponse :: Int -> ListServiceInstancesResponse
newListServiceInstancesResponse Int
pHttpStatus_ =
  ListServiceInstancesResponse'
    { $sel:nextToken:ListServiceInstancesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListServiceInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:serviceInstances:ListServiceInstancesResponse' :: [ServiceInstanceSummary]
serviceInstances = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token that indicates the location of the next service instance in the
-- array of service instances, after the current requested list of service
-- instances.
listServiceInstancesResponse_nextToken :: Lens.Lens' ListServiceInstancesResponse (Prelude.Maybe Prelude.Text)
listServiceInstancesResponse_nextToken :: Lens' ListServiceInstancesResponse (Maybe Text)
listServiceInstancesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstancesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListServiceInstancesResponse' :: ListServiceInstancesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListServiceInstancesResponse
s@ListServiceInstancesResponse' {} Maybe Text
a -> ListServiceInstancesResponse
s {$sel:nextToken:ListServiceInstancesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListServiceInstancesResponse)

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

-- | An array of service instances with summary data.
listServiceInstancesResponse_serviceInstances :: Lens.Lens' ListServiceInstancesResponse [ServiceInstanceSummary]
listServiceInstancesResponse_serviceInstances :: Lens' ListServiceInstancesResponse [ServiceInstanceSummary]
listServiceInstancesResponse_serviceInstances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListServiceInstancesResponse' {[ServiceInstanceSummary]
serviceInstances :: [ServiceInstanceSummary]
$sel:serviceInstances:ListServiceInstancesResponse' :: ListServiceInstancesResponse -> [ServiceInstanceSummary]
serviceInstances} -> [ServiceInstanceSummary]
serviceInstances) (\s :: ListServiceInstancesResponse
s@ListServiceInstancesResponse' {} [ServiceInstanceSummary]
a -> ListServiceInstancesResponse
s {$sel:serviceInstances:ListServiceInstancesResponse' :: [ServiceInstanceSummary]
serviceInstances = [ServiceInstanceSummary]
a} :: ListServiceInstancesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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