{-# 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.CodeGuruReviewer.ListCodeReviews
-- 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 all the code reviews that the customer has created in the past 90
-- days.
module Amazonka.CodeGuruReviewer.ListCodeReviews
  ( -- * Creating a Request
    ListCodeReviews (..),
    newListCodeReviews,

    -- * Request Lenses
    listCodeReviews_maxResults,
    listCodeReviews_nextToken,
    listCodeReviews_providerTypes,
    listCodeReviews_repositoryNames,
    listCodeReviews_states,
    listCodeReviews_type,

    -- * Destructuring the Response
    ListCodeReviewsResponse (..),
    newListCodeReviewsResponse,

    -- * Response Lenses
    listCodeReviewsResponse_codeReviewSummaries,
    listCodeReviewsResponse_nextToken,
    listCodeReviewsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListCodeReviews' smart constructor.
data ListCodeReviews = ListCodeReviews'
  { -- | The maximum number of results that are returned per call. The default is
    -- 100.
    ListCodeReviews -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If @nextToken@ is returned, there are more results available. The value
    -- of @nextToken@ is a unique pagination token for each page. Make the call
    -- again using the returned token to retrieve the next page. Keep all other
    -- arguments unchanged.
    ListCodeReviews -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | List of provider types for filtering that needs to be applied before
    -- displaying the result. For example, @providerTypes=[GitHub]@ lists code
    -- reviews from GitHub.
    ListCodeReviews -> Maybe (NonEmpty ProviderType)
providerTypes :: Prelude.Maybe (Prelude.NonEmpty ProviderType),
    -- | List of repository names for filtering that needs to be applied before
    -- displaying the result.
    ListCodeReviews -> Maybe (NonEmpty Text)
repositoryNames :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | List of states for filtering that needs to be applied before displaying
    -- the result. For example, @states=[Pending]@ lists code reviews in the
    -- Pending state.
    --
    -- The valid code review states are:
    --
    -- -   @Completed@: The code review is complete.
    --
    -- -   @Pending@: The code review started and has not completed or failed.
    --
    -- -   @Failed@: The code review failed.
    --
    -- -   @Deleting@: The code review is being deleted.
    ListCodeReviews -> Maybe (NonEmpty JobState)
states :: Prelude.Maybe (Prelude.NonEmpty JobState),
    -- | The type of code reviews to list in the response.
    ListCodeReviews -> Type
type' :: Type
  }
  deriving (ListCodeReviews -> ListCodeReviews -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCodeReviews -> ListCodeReviews -> Bool
$c/= :: ListCodeReviews -> ListCodeReviews -> Bool
== :: ListCodeReviews -> ListCodeReviews -> Bool
$c== :: ListCodeReviews -> ListCodeReviews -> Bool
Prelude.Eq, ReadPrec [ListCodeReviews]
ReadPrec ListCodeReviews
Int -> ReadS ListCodeReviews
ReadS [ListCodeReviews]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCodeReviews]
$creadListPrec :: ReadPrec [ListCodeReviews]
readPrec :: ReadPrec ListCodeReviews
$creadPrec :: ReadPrec ListCodeReviews
readList :: ReadS [ListCodeReviews]
$creadList :: ReadS [ListCodeReviews]
readsPrec :: Int -> ReadS ListCodeReviews
$creadsPrec :: Int -> ReadS ListCodeReviews
Prelude.Read, Int -> ListCodeReviews -> ShowS
[ListCodeReviews] -> ShowS
ListCodeReviews -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCodeReviews] -> ShowS
$cshowList :: [ListCodeReviews] -> ShowS
show :: ListCodeReviews -> String
$cshow :: ListCodeReviews -> String
showsPrec :: Int -> ListCodeReviews -> ShowS
$cshowsPrec :: Int -> ListCodeReviews -> ShowS
Prelude.Show, forall x. Rep ListCodeReviews x -> ListCodeReviews
forall x. ListCodeReviews -> Rep ListCodeReviews x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCodeReviews x -> ListCodeReviews
$cfrom :: forall x. ListCodeReviews -> Rep ListCodeReviews x
Prelude.Generic)

-- |
-- Create a value of 'ListCodeReviews' 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', 'listCodeReviews_maxResults' - The maximum number of results that are returned per call. The default is
-- 100.
--
-- 'nextToken', 'listCodeReviews_nextToken' - If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged.
--
-- 'providerTypes', 'listCodeReviews_providerTypes' - List of provider types for filtering that needs to be applied before
-- displaying the result. For example, @providerTypes=[GitHub]@ lists code
-- reviews from GitHub.
--
-- 'repositoryNames', 'listCodeReviews_repositoryNames' - List of repository names for filtering that needs to be applied before
-- displaying the result.
--
-- 'states', 'listCodeReviews_states' - List of states for filtering that needs to be applied before displaying
-- the result. For example, @states=[Pending]@ lists code reviews in the
-- Pending state.
--
-- The valid code review states are:
--
-- -   @Completed@: The code review is complete.
--
-- -   @Pending@: The code review started and has not completed or failed.
--
-- -   @Failed@: The code review failed.
--
-- -   @Deleting@: The code review is being deleted.
--
-- 'type'', 'listCodeReviews_type' - The type of code reviews to list in the response.
newListCodeReviews ::
  -- | 'type''
  Type ->
  ListCodeReviews
newListCodeReviews :: Type -> ListCodeReviews
newListCodeReviews Type
pType_ =
  ListCodeReviews'
    { $sel:maxResults:ListCodeReviews' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCodeReviews' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:providerTypes:ListCodeReviews' :: Maybe (NonEmpty ProviderType)
providerTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryNames:ListCodeReviews' :: Maybe (NonEmpty Text)
repositoryNames = forall a. Maybe a
Prelude.Nothing,
      $sel:states:ListCodeReviews' :: Maybe (NonEmpty JobState)
states = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ListCodeReviews' :: Type
type' = Type
pType_
    }

-- | The maximum number of results that are returned per call. The default is
-- 100.
listCodeReviews_maxResults :: Lens.Lens' ListCodeReviews (Prelude.Maybe Prelude.Natural)
listCodeReviews_maxResults :: Lens' ListCodeReviews (Maybe Natural)
listCodeReviews_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviews' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCodeReviews' :: ListCodeReviews -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCodeReviews
s@ListCodeReviews' {} Maybe Natural
a -> ListCodeReviews
s {$sel:maxResults:ListCodeReviews' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCodeReviews)

-- | If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ is a unique pagination token for each page. Make the call
-- again using the returned token to retrieve the next page. Keep all other
-- arguments unchanged.
listCodeReviews_nextToken :: Lens.Lens' ListCodeReviews (Prelude.Maybe Prelude.Text)
listCodeReviews_nextToken :: Lens' ListCodeReviews (Maybe Text)
listCodeReviews_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviews' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCodeReviews' :: ListCodeReviews -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCodeReviews
s@ListCodeReviews' {} Maybe Text
a -> ListCodeReviews
s {$sel:nextToken:ListCodeReviews' :: Maybe Text
nextToken = Maybe Text
a} :: ListCodeReviews)

-- | List of provider types for filtering that needs to be applied before
-- displaying the result. For example, @providerTypes=[GitHub]@ lists code
-- reviews from GitHub.
listCodeReviews_providerTypes :: Lens.Lens' ListCodeReviews (Prelude.Maybe (Prelude.NonEmpty ProviderType))
listCodeReviews_providerTypes :: Lens' ListCodeReviews (Maybe (NonEmpty ProviderType))
listCodeReviews_providerTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviews' {Maybe (NonEmpty ProviderType)
providerTypes :: Maybe (NonEmpty ProviderType)
$sel:providerTypes:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty ProviderType)
providerTypes} -> Maybe (NonEmpty ProviderType)
providerTypes) (\s :: ListCodeReviews
s@ListCodeReviews' {} Maybe (NonEmpty ProviderType)
a -> ListCodeReviews
s {$sel:providerTypes:ListCodeReviews' :: Maybe (NonEmpty ProviderType)
providerTypes = Maybe (NonEmpty ProviderType)
a} :: ListCodeReviews) 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

-- | List of repository names for filtering that needs to be applied before
-- displaying the result.
listCodeReviews_repositoryNames :: Lens.Lens' ListCodeReviews (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
listCodeReviews_repositoryNames :: Lens' ListCodeReviews (Maybe (NonEmpty Text))
listCodeReviews_repositoryNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviews' {Maybe (NonEmpty Text)
repositoryNames :: Maybe (NonEmpty Text)
$sel:repositoryNames:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty Text)
repositoryNames} -> Maybe (NonEmpty Text)
repositoryNames) (\s :: ListCodeReviews
s@ListCodeReviews' {} Maybe (NonEmpty Text)
a -> ListCodeReviews
s {$sel:repositoryNames:ListCodeReviews' :: Maybe (NonEmpty Text)
repositoryNames = Maybe (NonEmpty Text)
a} :: ListCodeReviews) 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

-- | List of states for filtering that needs to be applied before displaying
-- the result. For example, @states=[Pending]@ lists code reviews in the
-- Pending state.
--
-- The valid code review states are:
--
-- -   @Completed@: The code review is complete.
--
-- -   @Pending@: The code review started and has not completed or failed.
--
-- -   @Failed@: The code review failed.
--
-- -   @Deleting@: The code review is being deleted.
listCodeReviews_states :: Lens.Lens' ListCodeReviews (Prelude.Maybe (Prelude.NonEmpty JobState))
listCodeReviews_states :: Lens' ListCodeReviews (Maybe (NonEmpty JobState))
listCodeReviews_states = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviews' {Maybe (NonEmpty JobState)
states :: Maybe (NonEmpty JobState)
$sel:states:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty JobState)
states} -> Maybe (NonEmpty JobState)
states) (\s :: ListCodeReviews
s@ListCodeReviews' {} Maybe (NonEmpty JobState)
a -> ListCodeReviews
s {$sel:states:ListCodeReviews' :: Maybe (NonEmpty JobState)
states = Maybe (NonEmpty JobState)
a} :: ListCodeReviews) 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 type of code reviews to list in the response.
listCodeReviews_type :: Lens.Lens' ListCodeReviews Type
listCodeReviews_type :: Lens' ListCodeReviews Type
listCodeReviews_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviews' {Type
type' :: Type
$sel:type':ListCodeReviews' :: ListCodeReviews -> Type
type'} -> Type
type') (\s :: ListCodeReviews
s@ListCodeReviews' {} Type
a -> ListCodeReviews
s {$sel:type':ListCodeReviews' :: Type
type' = Type
a} :: ListCodeReviews)

instance Core.AWSRequest ListCodeReviews where
  type
    AWSResponse ListCodeReviews =
      ListCodeReviewsResponse
  request :: (Service -> Service) -> ListCodeReviews -> Request ListCodeReviews
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 ListCodeReviews
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListCodeReviews)))
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 [CodeReviewSummary]
-> Maybe Text -> Int -> ListCodeReviewsResponse
ListCodeReviewsResponse'
            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
"CodeReviewSummaries"
                            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 ListCodeReviews where
  hashWithSalt :: Int -> ListCodeReviews -> Int
hashWithSalt Int
_salt ListCodeReviews' {Maybe Natural
Maybe (NonEmpty Text)
Maybe (NonEmpty JobState)
Maybe (NonEmpty ProviderType)
Maybe Text
Type
type' :: Type
states :: Maybe (NonEmpty JobState)
repositoryNames :: Maybe (NonEmpty Text)
providerTypes :: Maybe (NonEmpty ProviderType)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListCodeReviews' :: ListCodeReviews -> Type
$sel:states:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty JobState)
$sel:repositoryNames:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty Text)
$sel:providerTypes:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty ProviderType)
$sel:nextToken:ListCodeReviews' :: ListCodeReviews -> Maybe Text
$sel:maxResults:ListCodeReviews' :: ListCodeReviews -> 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 ProviderType)
providerTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
repositoryNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty JobState)
states
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Type
type'

instance Prelude.NFData ListCodeReviews where
  rnf :: ListCodeReviews -> ()
rnf ListCodeReviews' {Maybe Natural
Maybe (NonEmpty Text)
Maybe (NonEmpty JobState)
Maybe (NonEmpty ProviderType)
Maybe Text
Type
type' :: Type
states :: Maybe (NonEmpty JobState)
repositoryNames :: Maybe (NonEmpty Text)
providerTypes :: Maybe (NonEmpty ProviderType)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListCodeReviews' :: ListCodeReviews -> Type
$sel:states:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty JobState)
$sel:repositoryNames:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty Text)
$sel:providerTypes:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty ProviderType)
$sel:nextToken:ListCodeReviews' :: ListCodeReviews -> Maybe Text
$sel:maxResults:ListCodeReviews' :: ListCodeReviews -> 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 ProviderType)
providerTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
repositoryNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty JobState)
states
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Type
type'

instance Data.ToHeaders ListCodeReviews where
  toHeaders :: ListCodeReviews -> 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 ListCodeReviews where
  toPath :: ListCodeReviews -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/codereviews"

instance Data.ToQuery ListCodeReviews where
  toQuery :: ListCodeReviews -> QueryString
toQuery ListCodeReviews' {Maybe Natural
Maybe (NonEmpty Text)
Maybe (NonEmpty JobState)
Maybe (NonEmpty ProviderType)
Maybe Text
Type
type' :: Type
states :: Maybe (NonEmpty JobState)
repositoryNames :: Maybe (NonEmpty Text)
providerTypes :: Maybe (NonEmpty ProviderType)
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListCodeReviews' :: ListCodeReviews -> Type
$sel:states:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty JobState)
$sel:repositoryNames:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty Text)
$sel:providerTypes:ListCodeReviews' :: ListCodeReviews -> Maybe (NonEmpty ProviderType)
$sel:nextToken:ListCodeReviews' :: ListCodeReviews -> Maybe Text
$sel:maxResults:ListCodeReviews' :: ListCodeReviews -> 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,
        ByteString
"ProviderTypes"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty ProviderType)
providerTypes
            ),
        ByteString
"RepositoryNames"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
repositoryNames
            ),
        ByteString
"States"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty JobState)
states),
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Type
type'
      ]

-- | /See:/ 'newListCodeReviewsResponse' smart constructor.
data ListCodeReviewsResponse = ListCodeReviewsResponse'
  { -- | A list of code reviews that meet the criteria of the request.
    ListCodeReviewsResponse -> Maybe [CodeReviewSummary]
codeReviewSummaries :: Prelude.Maybe [CodeReviewSummary],
    -- | Pagination token.
    ListCodeReviewsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCodeReviewsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCodeReviewsResponse -> ListCodeReviewsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCodeReviewsResponse -> ListCodeReviewsResponse -> Bool
$c/= :: ListCodeReviewsResponse -> ListCodeReviewsResponse -> Bool
== :: ListCodeReviewsResponse -> ListCodeReviewsResponse -> Bool
$c== :: ListCodeReviewsResponse -> ListCodeReviewsResponse -> Bool
Prelude.Eq, ReadPrec [ListCodeReviewsResponse]
ReadPrec ListCodeReviewsResponse
Int -> ReadS ListCodeReviewsResponse
ReadS [ListCodeReviewsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCodeReviewsResponse]
$creadListPrec :: ReadPrec [ListCodeReviewsResponse]
readPrec :: ReadPrec ListCodeReviewsResponse
$creadPrec :: ReadPrec ListCodeReviewsResponse
readList :: ReadS [ListCodeReviewsResponse]
$creadList :: ReadS [ListCodeReviewsResponse]
readsPrec :: Int -> ReadS ListCodeReviewsResponse
$creadsPrec :: Int -> ReadS ListCodeReviewsResponse
Prelude.Read, Int -> ListCodeReviewsResponse -> ShowS
[ListCodeReviewsResponse] -> ShowS
ListCodeReviewsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCodeReviewsResponse] -> ShowS
$cshowList :: [ListCodeReviewsResponse] -> ShowS
show :: ListCodeReviewsResponse -> String
$cshow :: ListCodeReviewsResponse -> String
showsPrec :: Int -> ListCodeReviewsResponse -> ShowS
$cshowsPrec :: Int -> ListCodeReviewsResponse -> ShowS
Prelude.Show, forall x. Rep ListCodeReviewsResponse x -> ListCodeReviewsResponse
forall x. ListCodeReviewsResponse -> Rep ListCodeReviewsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCodeReviewsResponse x -> ListCodeReviewsResponse
$cfrom :: forall x. ListCodeReviewsResponse -> Rep ListCodeReviewsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCodeReviewsResponse' 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:
--
-- 'codeReviewSummaries', 'listCodeReviewsResponse_codeReviewSummaries' - A list of code reviews that meet the criteria of the request.
--
-- 'nextToken', 'listCodeReviewsResponse_nextToken' - Pagination token.
--
-- 'httpStatus', 'listCodeReviewsResponse_httpStatus' - The response's http status code.
newListCodeReviewsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCodeReviewsResponse
newListCodeReviewsResponse :: Int -> ListCodeReviewsResponse
newListCodeReviewsResponse Int
pHttpStatus_ =
  ListCodeReviewsResponse'
    { $sel:codeReviewSummaries:ListCodeReviewsResponse' :: Maybe [CodeReviewSummary]
codeReviewSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCodeReviewsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCodeReviewsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of code reviews that meet the criteria of the request.
listCodeReviewsResponse_codeReviewSummaries :: Lens.Lens' ListCodeReviewsResponse (Prelude.Maybe [CodeReviewSummary])
listCodeReviewsResponse_codeReviewSummaries :: Lens' ListCodeReviewsResponse (Maybe [CodeReviewSummary])
listCodeReviewsResponse_codeReviewSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviewsResponse' {Maybe [CodeReviewSummary]
codeReviewSummaries :: Maybe [CodeReviewSummary]
$sel:codeReviewSummaries:ListCodeReviewsResponse' :: ListCodeReviewsResponse -> Maybe [CodeReviewSummary]
codeReviewSummaries} -> Maybe [CodeReviewSummary]
codeReviewSummaries) (\s :: ListCodeReviewsResponse
s@ListCodeReviewsResponse' {} Maybe [CodeReviewSummary]
a -> ListCodeReviewsResponse
s {$sel:codeReviewSummaries:ListCodeReviewsResponse' :: Maybe [CodeReviewSummary]
codeReviewSummaries = Maybe [CodeReviewSummary]
a} :: ListCodeReviewsResponse) 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

-- | Pagination token.
listCodeReviewsResponse_nextToken :: Lens.Lens' ListCodeReviewsResponse (Prelude.Maybe Prelude.Text)
listCodeReviewsResponse_nextToken :: Lens' ListCodeReviewsResponse (Maybe Text)
listCodeReviewsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCodeReviewsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCodeReviewsResponse' :: ListCodeReviewsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCodeReviewsResponse
s@ListCodeReviewsResponse' {} Maybe Text
a -> ListCodeReviewsResponse
s {$sel:nextToken:ListCodeReviewsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCodeReviewsResponse)

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

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