{-# 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.ResourceExplorer2.ListViews
-- 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 the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource names (ARNs)>
-- of the views available in the Amazon Web Services Region in which you
-- call this operation.
--
-- Always check the @NextToken@ response parameter for a @null@ value when
-- calling a paginated operation. These operations can occasionally return
-- an empty set of results even when there are more results available. The
-- @NextToken@ response parameter value is @null@ /only/ when there are no
-- more results to display.
--
-- This operation returns paginated results.
module Amazonka.ResourceExplorer2.ListViews
  ( -- * Creating a Request
    ListViews (..),
    newListViews,

    -- * Request Lenses
    listViews_maxResults,
    listViews_nextToken,

    -- * Destructuring the Response
    ListViewsResponse (..),
    newListViewsResponse,

    -- * Response Lenses
    listViewsResponse_nextToken,
    listViewsResponse_views,
    listViewsResponse_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 Amazonka.ResourceExplorer2.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newListViews' smart constructor.
data ListViews = ListViews'
  { -- | The maximum number of results that you want included on each page of the
    -- response. If you do not include this parameter, it defaults to a value
    -- appropriate to the operation. If additional items exist beyond those
    -- included in the current response, the @NextToken@ response element is
    -- present and has a value (is not null). Include that value as the
    -- @NextToken@ request parameter in the next call to the operation to get
    -- the next part of the results.
    --
    -- An API operation can return fewer results than the maximum even when
    -- there are more results available. You should check @NextToken@ after
    -- every operation to ensure that you receive all of the results.
    ListViews -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The parameter for receiving additional results if you receive a
    -- @NextToken@ response in a previous request. A @NextToken@ response
    -- indicates that more output is available. Set this parameter to the value
    -- of the previous call\'s @NextToken@ response to indicate where the
    -- output should continue from.
    ListViews -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListViews -> ListViews -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListViews -> ListViews -> Bool
$c/= :: ListViews -> ListViews -> Bool
== :: ListViews -> ListViews -> Bool
$c== :: ListViews -> ListViews -> Bool
Prelude.Eq, ReadPrec [ListViews]
ReadPrec ListViews
Int -> ReadS ListViews
ReadS [ListViews]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListViews]
$creadListPrec :: ReadPrec [ListViews]
readPrec :: ReadPrec ListViews
$creadPrec :: ReadPrec ListViews
readList :: ReadS [ListViews]
$creadList :: ReadS [ListViews]
readsPrec :: Int -> ReadS ListViews
$creadsPrec :: Int -> ReadS ListViews
Prelude.Read, Int -> ListViews -> ShowS
[ListViews] -> ShowS
ListViews -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListViews] -> ShowS
$cshowList :: [ListViews] -> ShowS
show :: ListViews -> String
$cshow :: ListViews -> String
showsPrec :: Int -> ListViews -> ShowS
$cshowsPrec :: Int -> ListViews -> ShowS
Prelude.Show, forall x. Rep ListViews x -> ListViews
forall x. ListViews -> Rep ListViews x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListViews x -> ListViews
$cfrom :: forall x. ListViews -> Rep ListViews x
Prelude.Generic)

-- |
-- Create a value of 'ListViews' 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:
--
-- 'maxResults', 'listViews_maxResults' - The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
--
-- 'nextToken', 'listViews_nextToken' - The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
newListViews ::
  ListViews
newListViews :: ListViews
newListViews =
  ListViews'
    { $sel:maxResults:ListViews' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListViews' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
listViews_maxResults :: Lens.Lens' ListViews (Prelude.Maybe Prelude.Natural)
listViews_maxResults :: Lens' ListViews (Maybe Natural)
listViews_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListViews' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListViews' :: ListViews -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListViews
s@ListViews' {} Maybe Natural
a -> ListViews
s {$sel:maxResults:ListViews' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListViews)

-- | The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
listViews_nextToken :: Lens.Lens' ListViews (Prelude.Maybe Prelude.Text)
listViews_nextToken :: Lens' ListViews (Maybe Text)
listViews_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListViews' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListViews' :: ListViews -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListViews
s@ListViews' {} Maybe Text
a -> ListViews
s {$sel:nextToken:ListViews' :: Maybe Text
nextToken = Maybe Text
a} :: ListViews)

instance Core.AWSPager ListViews where
  page :: ListViews -> AWSResponse ListViews -> Maybe ListViews
page ListViews
rq AWSResponse ListViews
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListViews
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListViewsResponse (Maybe Text)
listViewsResponse_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 ListViews
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListViewsResponse (Maybe [Text])
listViewsResponse_views
            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.$ ListViews
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListViews (Maybe Text)
listViews_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListViews
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListViewsResponse (Maybe Text)
listViewsResponse_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 ListViews where
  type AWSResponse ListViews = ListViewsResponse
  request :: (Service -> Service) -> ListViews -> Request ListViews
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 ListViews
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListViews)))
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 [Text] -> Int -> ListViewsResponse
ListViewsResponse'
            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
"Views" 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 ListViews where
  hashWithSalt :: Int -> ListViews -> Int
hashWithSalt Int
_salt ListViews' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListViews' :: ListViews -> Maybe Text
$sel:maxResults:ListViews' :: ListViews -> Maybe Natural
..} =
    Int
_salt
      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 ListViews where
  rnf :: ListViews -> ()
rnf ListViews' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListViews' :: ListViews -> Maybe Text
$sel:maxResults:ListViews' :: ListViews -> Maybe Natural
..} =
    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 ListViews where
  toHeaders :: ListViews -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListViews where
  toJSON :: ListViews -> Value
toJSON ListViews' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListViews' :: ListViews -> Maybe Text
$sel:maxResults:ListViews' :: ListViews -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 ListViews where
  toPath :: ListViews -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/ListViews"

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

-- | /See:/ 'newListViewsResponse' smart constructor.
data ListViewsResponse = ListViewsResponse'
  { -- | If present, indicates that more output is available than is included in
    -- the current response. Use this value in the @NextToken@ request
    -- parameter in a subsequent call to the operation to get the next part of
    -- the output. You should repeat this until the @NextToken@ response
    -- element comes back as @null@.
    ListViewsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of views available in the Amazon Web Services Region in which
    -- you called this operation.
    ListViewsResponse -> Maybe [Text]
views :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    ListViewsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListViewsResponse -> ListViewsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListViewsResponse -> ListViewsResponse -> Bool
$c/= :: ListViewsResponse -> ListViewsResponse -> Bool
== :: ListViewsResponse -> ListViewsResponse -> Bool
$c== :: ListViewsResponse -> ListViewsResponse -> Bool
Prelude.Eq, ReadPrec [ListViewsResponse]
ReadPrec ListViewsResponse
Int -> ReadS ListViewsResponse
ReadS [ListViewsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListViewsResponse]
$creadListPrec :: ReadPrec [ListViewsResponse]
readPrec :: ReadPrec ListViewsResponse
$creadPrec :: ReadPrec ListViewsResponse
readList :: ReadS [ListViewsResponse]
$creadList :: ReadS [ListViewsResponse]
readsPrec :: Int -> ReadS ListViewsResponse
$creadsPrec :: Int -> ReadS ListViewsResponse
Prelude.Read, Int -> ListViewsResponse -> ShowS
[ListViewsResponse] -> ShowS
ListViewsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListViewsResponse] -> ShowS
$cshowList :: [ListViewsResponse] -> ShowS
show :: ListViewsResponse -> String
$cshow :: ListViewsResponse -> String
showsPrec :: Int -> ListViewsResponse -> ShowS
$cshowsPrec :: Int -> ListViewsResponse -> ShowS
Prelude.Show, forall x. Rep ListViewsResponse x -> ListViewsResponse
forall x. ListViewsResponse -> Rep ListViewsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListViewsResponse x -> ListViewsResponse
$cfrom :: forall x. ListViewsResponse -> Rep ListViewsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListViewsResponse' 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', 'listViewsResponse_nextToken' - If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
--
-- 'views', 'listViewsResponse_views' - The list of views available in the Amazon Web Services Region in which
-- you called this operation.
--
-- 'httpStatus', 'listViewsResponse_httpStatus' - The response's http status code.
newListViewsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListViewsResponse
newListViewsResponse :: Int -> ListViewsResponse
newListViewsResponse Int
pHttpStatus_ =
  ListViewsResponse'
    { $sel:nextToken:ListViewsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:views:ListViewsResponse' :: Maybe [Text]
views = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListViewsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
listViewsResponse_nextToken :: Lens.Lens' ListViewsResponse (Prelude.Maybe Prelude.Text)
listViewsResponse_nextToken :: Lens' ListViewsResponse (Maybe Text)
listViewsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListViewsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListViewsResponse' :: ListViewsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListViewsResponse
s@ListViewsResponse' {} Maybe Text
a -> ListViewsResponse
s {$sel:nextToken:ListViewsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListViewsResponse)

-- | The list of views available in the Amazon Web Services Region in which
-- you called this operation.
listViewsResponse_views :: Lens.Lens' ListViewsResponse (Prelude.Maybe [Prelude.Text])
listViewsResponse_views :: Lens' ListViewsResponse (Maybe [Text])
listViewsResponse_views = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListViewsResponse' {Maybe [Text]
views :: Maybe [Text]
$sel:views:ListViewsResponse' :: ListViewsResponse -> Maybe [Text]
views} -> Maybe [Text]
views) (\s :: ListViewsResponse
s@ListViewsResponse' {} Maybe [Text]
a -> ListViewsResponse
s {$sel:views:ListViewsResponse' :: Maybe [Text]
views = Maybe [Text]
a} :: ListViewsResponse) 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.
listViewsResponse_httpStatus :: Lens.Lens' ListViewsResponse Prelude.Int
listViewsResponse_httpStatus :: Lens' ListViewsResponse Int
listViewsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListViewsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListViewsResponse' :: ListViewsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListViewsResponse
s@ListViewsResponse' {} Int
a -> ListViewsResponse
s {$sel:httpStatus:ListViewsResponse' :: Int
httpStatus = Int
a} :: ListViewsResponse)

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