{-# 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.Rekognition.DescribeProjects
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about your Amazon Rekognition Custom Labels projects.
--
-- This operation requires permissions to perform the
-- @rekognition:DescribeProjects@ action.
--
-- This operation returns paginated results.
module Amazonka.Rekognition.DescribeProjects
  ( -- * Creating a Request
    DescribeProjects (..),
    newDescribeProjects,

    -- * Request Lenses
    describeProjects_maxResults,
    describeProjects_nextToken,
    describeProjects_projectNames,

    -- * Destructuring the Response
    DescribeProjectsResponse (..),
    newDescribeProjectsResponse,

    -- * Response Lenses
    describeProjectsResponse_nextToken,
    describeProjectsResponse_projectDescriptions,
    describeProjectsResponse_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 Amazonka.Rekognition.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeProjects' smart constructor.
data DescribeProjects = DescribeProjects'
  { -- | The maximum number of results to return per paginated call. The largest
    -- value you can specify is 100. If you specify a value greater than 100, a
    -- ValidationException error occurs. The default value is 100.
    DescribeProjects -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the previous response was incomplete (because there is more results
    -- to retrieve), Amazon Rekognition Custom Labels returns a pagination
    -- token in the response. You can use this pagination token to retrieve the
    -- next set of results.
    DescribeProjects -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of the projects that you want Amazon Rekognition Custom Labels to
    -- describe. If you don\'t specify a value, the response includes
    -- descriptions for all the projects in your AWS account.
    DescribeProjects -> Maybe (NonEmpty Text)
projectNames :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text)
  }
  deriving (DescribeProjects -> DescribeProjects -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProjects -> DescribeProjects -> Bool
$c/= :: DescribeProjects -> DescribeProjects -> Bool
== :: DescribeProjects -> DescribeProjects -> Bool
$c== :: DescribeProjects -> DescribeProjects -> Bool
Prelude.Eq, ReadPrec [DescribeProjects]
ReadPrec DescribeProjects
Int -> ReadS DescribeProjects
ReadS [DescribeProjects]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProjects]
$creadListPrec :: ReadPrec [DescribeProjects]
readPrec :: ReadPrec DescribeProjects
$creadPrec :: ReadPrec DescribeProjects
readList :: ReadS [DescribeProjects]
$creadList :: ReadS [DescribeProjects]
readsPrec :: Int -> ReadS DescribeProjects
$creadsPrec :: Int -> ReadS DescribeProjects
Prelude.Read, Int -> DescribeProjects -> ShowS
[DescribeProjects] -> ShowS
DescribeProjects -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProjects] -> ShowS
$cshowList :: [DescribeProjects] -> ShowS
show :: DescribeProjects -> String
$cshow :: DescribeProjects -> String
showsPrec :: Int -> DescribeProjects -> ShowS
$cshowsPrec :: Int -> DescribeProjects -> ShowS
Prelude.Show, forall x. Rep DescribeProjects x -> DescribeProjects
forall x. DescribeProjects -> Rep DescribeProjects x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeProjects x -> DescribeProjects
$cfrom :: forall x. DescribeProjects -> Rep DescribeProjects x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProjects' 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', 'describeProjects_maxResults' - The maximum number of results to return per paginated call. The largest
-- value you can specify is 100. If you specify a value greater than 100, a
-- ValidationException error occurs. The default value is 100.
--
-- 'nextToken', 'describeProjects_nextToken' - If the previous response was incomplete (because there is more results
-- to retrieve), Amazon Rekognition Custom Labels returns a pagination
-- token in the response. You can use this pagination token to retrieve the
-- next set of results.
--
-- 'projectNames', 'describeProjects_projectNames' - A list of the projects that you want Amazon Rekognition Custom Labels to
-- describe. If you don\'t specify a value, the response includes
-- descriptions for all the projects in your AWS account.
newDescribeProjects ::
  DescribeProjects
newDescribeProjects :: DescribeProjects
newDescribeProjects =
  DescribeProjects'
    { $sel:maxResults:DescribeProjects' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeProjects' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:projectNames:DescribeProjects' :: Maybe (NonEmpty Text)
projectNames = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results to return per paginated call. The largest
-- value you can specify is 100. If you specify a value greater than 100, a
-- ValidationException error occurs. The default value is 100.
describeProjects_maxResults :: Lens.Lens' DescribeProjects (Prelude.Maybe Prelude.Natural)
describeProjects_maxResults :: Lens' DescribeProjects (Maybe Natural)
describeProjects_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjects' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeProjects' :: DescribeProjects -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeProjects
s@DescribeProjects' {} Maybe Natural
a -> DescribeProjects
s {$sel:maxResults:DescribeProjects' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeProjects)

-- | If the previous response was incomplete (because there is more results
-- to retrieve), Amazon Rekognition Custom Labels returns a pagination
-- token in the response. You can use this pagination token to retrieve the
-- next set of results.
describeProjects_nextToken :: Lens.Lens' DescribeProjects (Prelude.Maybe Prelude.Text)
describeProjects_nextToken :: Lens' DescribeProjects (Maybe Text)
describeProjects_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjects' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeProjects' :: DescribeProjects -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeProjects
s@DescribeProjects' {} Maybe Text
a -> DescribeProjects
s {$sel:nextToken:DescribeProjects' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeProjects)

-- | A list of the projects that you want Amazon Rekognition Custom Labels to
-- describe. If you don\'t specify a value, the response includes
-- descriptions for all the projects in your AWS account.
describeProjects_projectNames :: Lens.Lens' DescribeProjects (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
describeProjects_projectNames :: Lens' DescribeProjects (Maybe (NonEmpty Text))
describeProjects_projectNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjects' {Maybe (NonEmpty Text)
projectNames :: Maybe (NonEmpty Text)
$sel:projectNames:DescribeProjects' :: DescribeProjects -> Maybe (NonEmpty Text)
projectNames} -> Maybe (NonEmpty Text)
projectNames) (\s :: DescribeProjects
s@DescribeProjects' {} Maybe (NonEmpty Text)
a -> DescribeProjects
s {$sel:projectNames:DescribeProjects' :: Maybe (NonEmpty Text)
projectNames = Maybe (NonEmpty Text)
a} :: DescribeProjects) 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

instance Core.AWSPager DescribeProjects where
  page :: DescribeProjects
-> AWSResponse DescribeProjects -> Maybe DescribeProjects
page DescribeProjects
rq AWSResponse DescribeProjects
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeProjects
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeProjectsResponse (Maybe Text)
describeProjectsResponse_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 DescribeProjects
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeProjectsResponse (Maybe [ProjectDescription])
describeProjectsResponse_projectDescriptions
            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.$ DescribeProjects
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeProjects (Maybe Text)
describeProjects_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeProjects
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeProjectsResponse (Maybe Text)
describeProjectsResponse_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 DescribeProjects where
  type
    AWSResponse DescribeProjects =
      DescribeProjectsResponse
  request :: (Service -> Service)
-> DescribeProjects -> Request DescribeProjects
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 DescribeProjects
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeProjects)))
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 [ProjectDescription] -> Int -> DescribeProjectsResponse
DescribeProjectsResponse'
            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
"ProjectDescriptions"
                            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 DescribeProjects where
  hashWithSalt :: Int -> DescribeProjects -> Int
hashWithSalt Int
_salt DescribeProjects' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
projectNames :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:projectNames:DescribeProjects' :: DescribeProjects -> Maybe (NonEmpty Text)
$sel:nextToken:DescribeProjects' :: DescribeProjects -> Maybe Text
$sel:maxResults:DescribeProjects' :: DescribeProjects -> 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` Maybe (NonEmpty Text)
projectNames

instance Prelude.NFData DescribeProjects where
  rnf :: DescribeProjects -> ()
rnf DescribeProjects' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
projectNames :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:projectNames:DescribeProjects' :: DescribeProjects -> Maybe (NonEmpty Text)
$sel:nextToken:DescribeProjects' :: DescribeProjects -> Maybe Text
$sel:maxResults:DescribeProjects' :: DescribeProjects -> 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 Maybe (NonEmpty Text)
projectNames

instance Data.ToHeaders DescribeProjects where
  toHeaders :: DescribeProjects -> 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
"RekognitionService.DescribeProjects" ::
                          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 DescribeProjects where
  toJSON :: DescribeProjects -> Value
toJSON DescribeProjects' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
projectNames :: Maybe (NonEmpty Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:projectNames:DescribeProjects' :: DescribeProjects -> Maybe (NonEmpty Text)
$sel:nextToken:DescribeProjects' :: DescribeProjects -> Maybe Text
$sel:maxResults:DescribeProjects' :: DescribeProjects -> 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,
            (Key
"ProjectNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
projectNames
          ]
      )

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

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

-- | /See:/ 'newDescribeProjectsResponse' smart constructor.
data DescribeProjectsResponse = DescribeProjectsResponse'
  { -- | If the previous response was incomplete (because there is more results
    -- to retrieve), Amazon Rekognition Custom Labels returns a pagination
    -- token in the response. You can use this pagination token to retrieve the
    -- next set of results.
    DescribeProjectsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of project descriptions. The list is sorted by the date and time
    -- the projects are created.
    DescribeProjectsResponse -> Maybe [ProjectDescription]
projectDescriptions :: Prelude.Maybe [ProjectDescription],
    -- | The response's http status code.
    DescribeProjectsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeProjectsResponse -> DescribeProjectsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeProjectsResponse -> DescribeProjectsResponse -> Bool
$c/= :: DescribeProjectsResponse -> DescribeProjectsResponse -> Bool
== :: DescribeProjectsResponse -> DescribeProjectsResponse -> Bool
$c== :: DescribeProjectsResponse -> DescribeProjectsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeProjectsResponse]
ReadPrec DescribeProjectsResponse
Int -> ReadS DescribeProjectsResponse
ReadS [DescribeProjectsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeProjectsResponse]
$creadListPrec :: ReadPrec [DescribeProjectsResponse]
readPrec :: ReadPrec DescribeProjectsResponse
$creadPrec :: ReadPrec DescribeProjectsResponse
readList :: ReadS [DescribeProjectsResponse]
$creadList :: ReadS [DescribeProjectsResponse]
readsPrec :: Int -> ReadS DescribeProjectsResponse
$creadsPrec :: Int -> ReadS DescribeProjectsResponse
Prelude.Read, Int -> DescribeProjectsResponse -> ShowS
[DescribeProjectsResponse] -> ShowS
DescribeProjectsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeProjectsResponse] -> ShowS
$cshowList :: [DescribeProjectsResponse] -> ShowS
show :: DescribeProjectsResponse -> String
$cshow :: DescribeProjectsResponse -> String
showsPrec :: Int -> DescribeProjectsResponse -> ShowS
$cshowsPrec :: Int -> DescribeProjectsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeProjectsResponse x -> DescribeProjectsResponse
forall x.
DescribeProjectsResponse -> Rep DescribeProjectsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeProjectsResponse x -> DescribeProjectsResponse
$cfrom :: forall x.
DescribeProjectsResponse -> Rep DescribeProjectsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeProjectsResponse' 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', 'describeProjectsResponse_nextToken' - If the previous response was incomplete (because there is more results
-- to retrieve), Amazon Rekognition Custom Labels returns a pagination
-- token in the response. You can use this pagination token to retrieve the
-- next set of results.
--
-- 'projectDescriptions', 'describeProjectsResponse_projectDescriptions' - A list of project descriptions. The list is sorted by the date and time
-- the projects are created.
--
-- 'httpStatus', 'describeProjectsResponse_httpStatus' - The response's http status code.
newDescribeProjectsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeProjectsResponse
newDescribeProjectsResponse :: Int -> DescribeProjectsResponse
newDescribeProjectsResponse Int
pHttpStatus_ =
  DescribeProjectsResponse'
    { $sel:nextToken:DescribeProjectsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:projectDescriptions:DescribeProjectsResponse' :: Maybe [ProjectDescription]
projectDescriptions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeProjectsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the previous response was incomplete (because there is more results
-- to retrieve), Amazon Rekognition Custom Labels returns a pagination
-- token in the response. You can use this pagination token to retrieve the
-- next set of results.
describeProjectsResponse_nextToken :: Lens.Lens' DescribeProjectsResponse (Prelude.Maybe Prelude.Text)
describeProjectsResponse_nextToken :: Lens' DescribeProjectsResponse (Maybe Text)
describeProjectsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeProjectsResponse' :: DescribeProjectsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeProjectsResponse
s@DescribeProjectsResponse' {} Maybe Text
a -> DescribeProjectsResponse
s {$sel:nextToken:DescribeProjectsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeProjectsResponse)

-- | A list of project descriptions. The list is sorted by the date and time
-- the projects are created.
describeProjectsResponse_projectDescriptions :: Lens.Lens' DescribeProjectsResponse (Prelude.Maybe [ProjectDescription])
describeProjectsResponse_projectDescriptions :: Lens' DescribeProjectsResponse (Maybe [ProjectDescription])
describeProjectsResponse_projectDescriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectsResponse' {Maybe [ProjectDescription]
projectDescriptions :: Maybe [ProjectDescription]
$sel:projectDescriptions:DescribeProjectsResponse' :: DescribeProjectsResponse -> Maybe [ProjectDescription]
projectDescriptions} -> Maybe [ProjectDescription]
projectDescriptions) (\s :: DescribeProjectsResponse
s@DescribeProjectsResponse' {} Maybe [ProjectDescription]
a -> DescribeProjectsResponse
s {$sel:projectDescriptions:DescribeProjectsResponse' :: Maybe [ProjectDescription]
projectDescriptions = Maybe [ProjectDescription]
a} :: DescribeProjectsResponse) 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.
describeProjectsResponse_httpStatus :: Lens.Lens' DescribeProjectsResponse Prelude.Int
describeProjectsResponse_httpStatus :: Lens' DescribeProjectsResponse Int
describeProjectsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeProjectsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeProjectsResponse' :: DescribeProjectsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeProjectsResponse
s@DescribeProjectsResponse' {} Int
a -> DescribeProjectsResponse
s {$sel:httpStatus:DescribeProjectsResponse' :: Int
httpStatus = Int
a} :: DescribeProjectsResponse)

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