{-# 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.Evidently.ListFeatures
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns configuration details about all the features in the specified
-- project.
--
-- This operation returns paginated results.
module Amazonka.Evidently.ListFeatures
  ( -- * Creating a Request
    ListFeatures (..),
    newListFeatures,

    -- * Request Lenses
    listFeatures_maxResults,
    listFeatures_nextToken,
    listFeatures_project,

    -- * Destructuring the Response
    ListFeaturesResponse (..),
    newListFeaturesResponse,

    -- * Response Lenses
    listFeaturesResponse_features,
    listFeaturesResponse_nextToken,
    listFeaturesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Evidently.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListFeatures' smart constructor.
data ListFeatures = ListFeatures'
  { -- | The maximum number of results to include in the response.
    ListFeatures -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to use when requesting the next set of results. You received
    -- this token from a previous @ListFeatures@ operation.
    ListFeatures -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name or ARN of the project to return the feature list from.
    ListFeatures -> Text
project :: Prelude.Text
  }
  deriving (ListFeatures -> ListFeatures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFeatures -> ListFeatures -> Bool
$c/= :: ListFeatures -> ListFeatures -> Bool
== :: ListFeatures -> ListFeatures -> Bool
$c== :: ListFeatures -> ListFeatures -> Bool
Prelude.Eq, ReadPrec [ListFeatures]
ReadPrec ListFeatures
Int -> ReadS ListFeatures
ReadS [ListFeatures]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFeatures]
$creadListPrec :: ReadPrec [ListFeatures]
readPrec :: ReadPrec ListFeatures
$creadPrec :: ReadPrec ListFeatures
readList :: ReadS [ListFeatures]
$creadList :: ReadS [ListFeatures]
readsPrec :: Int -> ReadS ListFeatures
$creadsPrec :: Int -> ReadS ListFeatures
Prelude.Read, Int -> ListFeatures -> ShowS
[ListFeatures] -> ShowS
ListFeatures -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFeatures] -> ShowS
$cshowList :: [ListFeatures] -> ShowS
show :: ListFeatures -> String
$cshow :: ListFeatures -> String
showsPrec :: Int -> ListFeatures -> ShowS
$cshowsPrec :: Int -> ListFeatures -> ShowS
Prelude.Show, forall x. Rep ListFeatures x -> ListFeatures
forall x. ListFeatures -> Rep ListFeatures x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFeatures x -> ListFeatures
$cfrom :: forall x. ListFeatures -> Rep ListFeatures x
Prelude.Generic)

-- |
-- Create a value of 'ListFeatures' 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', 'listFeatures_maxResults' - The maximum number of results to include in the response.
--
-- 'nextToken', 'listFeatures_nextToken' - The token to use when requesting the next set of results. You received
-- this token from a previous @ListFeatures@ operation.
--
-- 'project', 'listFeatures_project' - The name or ARN of the project to return the feature list from.
newListFeatures ::
  -- | 'project'
  Prelude.Text ->
  ListFeatures
newListFeatures :: Text -> ListFeatures
newListFeatures Text
pProject_ =
  ListFeatures'
    { $sel:maxResults:ListFeatures' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFeatures' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:project:ListFeatures' :: Text
project = Text
pProject_
    }

-- | The maximum number of results to include in the response.
listFeatures_maxResults :: Lens.Lens' ListFeatures (Prelude.Maybe Prelude.Natural)
listFeatures_maxResults :: Lens' ListFeatures (Maybe Natural)
listFeatures_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatures' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListFeatures' :: ListFeatures -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListFeatures
s@ListFeatures' {} Maybe Natural
a -> ListFeatures
s {$sel:maxResults:ListFeatures' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListFeatures)

-- | The token to use when requesting the next set of results. You received
-- this token from a previous @ListFeatures@ operation.
listFeatures_nextToken :: Lens.Lens' ListFeatures (Prelude.Maybe Prelude.Text)
listFeatures_nextToken :: Lens' ListFeatures (Maybe Text)
listFeatures_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatures' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFeatures' :: ListFeatures -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFeatures
s@ListFeatures' {} Maybe Text
a -> ListFeatures
s {$sel:nextToken:ListFeatures' :: Maybe Text
nextToken = Maybe Text
a} :: ListFeatures)

-- | The name or ARN of the project to return the feature list from.
listFeatures_project :: Lens.Lens' ListFeatures Prelude.Text
listFeatures_project :: Lens' ListFeatures Text
listFeatures_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatures' {Text
project :: Text
$sel:project:ListFeatures' :: ListFeatures -> Text
project} -> Text
project) (\s :: ListFeatures
s@ListFeatures' {} Text
a -> ListFeatures
s {$sel:project:ListFeatures' :: Text
project = Text
a} :: ListFeatures)

instance Core.AWSPager ListFeatures where
  page :: ListFeatures -> AWSResponse ListFeatures -> Maybe ListFeatures
page ListFeatures
rq AWSResponse ListFeatures
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListFeatures
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFeaturesResponse (Maybe Text)
listFeaturesResponse_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 ListFeatures
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFeaturesResponse (Maybe [FeatureSummary])
listFeaturesResponse_features
            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.$ ListFeatures
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListFeatures (Maybe Text)
listFeatures_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListFeatures
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFeaturesResponse (Maybe Text)
listFeaturesResponse_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 ListFeatures where
  type AWSResponse ListFeatures = ListFeaturesResponse
  request :: (Service -> Service) -> ListFeatures -> Request ListFeatures
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListFeatures
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListFeatures)))
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 [FeatureSummary] -> Maybe Text -> Int -> ListFeaturesResponse
ListFeaturesResponse'
            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
"features" 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 ListFeatures where
  hashWithSalt :: Int -> ListFeatures -> Int
hashWithSalt Int
_salt ListFeatures' {Maybe Natural
Maybe Text
Text
project :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:project:ListFeatures' :: ListFeatures -> Text
$sel:nextToken:ListFeatures' :: ListFeatures -> Maybe Text
$sel:maxResults:ListFeatures' :: ListFeatures -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData ListFeatures where
  rnf :: ListFeatures -> ()
rnf ListFeatures' {Maybe Natural
Maybe Text
Text
project :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:project:ListFeatures' :: ListFeatures -> Text
$sel:nextToken:ListFeatures' :: ListFeatures -> Maybe Text
$sel:maxResults:ListFeatures' :: ListFeatures -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

instance Data.ToHeaders ListFeatures where
  toHeaders :: ListFeatures -> 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.ToPath ListFeatures where
  toPath :: ListFeatures -> ByteString
toPath ListFeatures' {Maybe Natural
Maybe Text
Text
project :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:project:ListFeatures' :: ListFeatures -> Text
$sel:nextToken:ListFeatures' :: ListFeatures -> Maybe Text
$sel:maxResults:ListFeatures' :: ListFeatures -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/projects/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
project, ByteString
"/features"]

instance Data.ToQuery ListFeatures where
  toQuery :: ListFeatures -> QueryString
toQuery ListFeatures' {Maybe Natural
Maybe Text
Text
project :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:project:ListFeatures' :: ListFeatures -> Text
$sel:nextToken:ListFeatures' :: ListFeatures -> Maybe Text
$sel:maxResults:ListFeatures' :: ListFeatures -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListFeaturesResponse' smart constructor.
data ListFeaturesResponse = ListFeaturesResponse'
  { -- | An array of structures that contain the configuration details of the
    -- features in the specified project.
    ListFeaturesResponse -> Maybe [FeatureSummary]
features :: Prelude.Maybe [FeatureSummary],
    -- | The token to use in a subsequent @ListFeatures@ operation to return the
    -- next set of results.
    ListFeaturesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListFeaturesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListFeaturesResponse -> ListFeaturesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFeaturesResponse -> ListFeaturesResponse -> Bool
$c/= :: ListFeaturesResponse -> ListFeaturesResponse -> Bool
== :: ListFeaturesResponse -> ListFeaturesResponse -> Bool
$c== :: ListFeaturesResponse -> ListFeaturesResponse -> Bool
Prelude.Eq, ReadPrec [ListFeaturesResponse]
ReadPrec ListFeaturesResponse
Int -> ReadS ListFeaturesResponse
ReadS [ListFeaturesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFeaturesResponse]
$creadListPrec :: ReadPrec [ListFeaturesResponse]
readPrec :: ReadPrec ListFeaturesResponse
$creadPrec :: ReadPrec ListFeaturesResponse
readList :: ReadS [ListFeaturesResponse]
$creadList :: ReadS [ListFeaturesResponse]
readsPrec :: Int -> ReadS ListFeaturesResponse
$creadsPrec :: Int -> ReadS ListFeaturesResponse
Prelude.Read, Int -> ListFeaturesResponse -> ShowS
[ListFeaturesResponse] -> ShowS
ListFeaturesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFeaturesResponse] -> ShowS
$cshowList :: [ListFeaturesResponse] -> ShowS
show :: ListFeaturesResponse -> String
$cshow :: ListFeaturesResponse -> String
showsPrec :: Int -> ListFeaturesResponse -> ShowS
$cshowsPrec :: Int -> ListFeaturesResponse -> ShowS
Prelude.Show, forall x. Rep ListFeaturesResponse x -> ListFeaturesResponse
forall x. ListFeaturesResponse -> Rep ListFeaturesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFeaturesResponse x -> ListFeaturesResponse
$cfrom :: forall x. ListFeaturesResponse -> Rep ListFeaturesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListFeaturesResponse' 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:
--
-- 'features', 'listFeaturesResponse_features' - An array of structures that contain the configuration details of the
-- features in the specified project.
--
-- 'nextToken', 'listFeaturesResponse_nextToken' - The token to use in a subsequent @ListFeatures@ operation to return the
-- next set of results.
--
-- 'httpStatus', 'listFeaturesResponse_httpStatus' - The response's http status code.
newListFeaturesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListFeaturesResponse
newListFeaturesResponse :: Int -> ListFeaturesResponse
newListFeaturesResponse Int
pHttpStatus_ =
  ListFeaturesResponse'
    { $sel:features:ListFeaturesResponse' :: Maybe [FeatureSummary]
features = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFeaturesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListFeaturesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of structures that contain the configuration details of the
-- features in the specified project.
listFeaturesResponse_features :: Lens.Lens' ListFeaturesResponse (Prelude.Maybe [FeatureSummary])
listFeaturesResponse_features :: Lens' ListFeaturesResponse (Maybe [FeatureSummary])
listFeaturesResponse_features = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeaturesResponse' {Maybe [FeatureSummary]
features :: Maybe [FeatureSummary]
$sel:features:ListFeaturesResponse' :: ListFeaturesResponse -> Maybe [FeatureSummary]
features} -> Maybe [FeatureSummary]
features) (\s :: ListFeaturesResponse
s@ListFeaturesResponse' {} Maybe [FeatureSummary]
a -> ListFeaturesResponse
s {$sel:features:ListFeaturesResponse' :: Maybe [FeatureSummary]
features = Maybe [FeatureSummary]
a} :: ListFeaturesResponse) 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 to use in a subsequent @ListFeatures@ operation to return the
-- next set of results.
listFeaturesResponse_nextToken :: Lens.Lens' ListFeaturesResponse (Prelude.Maybe Prelude.Text)
listFeaturesResponse_nextToken :: Lens' ListFeaturesResponse (Maybe Text)
listFeaturesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeaturesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFeaturesResponse' :: ListFeaturesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFeaturesResponse
s@ListFeaturesResponse' {} Maybe Text
a -> ListFeaturesResponse
s {$sel:nextToken:ListFeaturesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListFeaturesResponse)

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

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