{-# 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.CodeDeploy.ListDeploymentConfigs
-- 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 deployment configurations with the IAM user or Amazon Web
-- Services account.
--
-- This operation returns paginated results.
module Amazonka.CodeDeploy.ListDeploymentConfigs
  ( -- * Creating a Request
    ListDeploymentConfigs (..),
    newListDeploymentConfigs,

    -- * Request Lenses
    listDeploymentConfigs_nextToken,

    -- * Destructuring the Response
    ListDeploymentConfigsResponse (..),
    newListDeploymentConfigsResponse,

    -- * Response Lenses
    listDeploymentConfigsResponse_deploymentConfigsList,
    listDeploymentConfigsResponse_nextToken,
    listDeploymentConfigsResponse_httpStatus,
  )
where

import Amazonka.CodeDeploy.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

-- | Represents the input of a @ListDeploymentConfigs@ operation.
--
-- /See:/ 'newListDeploymentConfigs' smart constructor.
data ListDeploymentConfigs = ListDeploymentConfigs'
  { -- | An identifier returned from the previous @ListDeploymentConfigs@ call.
    -- It can be used to return the next set of deployment configurations in
    -- the list.
    ListDeploymentConfigs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListDeploymentConfigs -> ListDeploymentConfigs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDeploymentConfigs -> ListDeploymentConfigs -> Bool
$c/= :: ListDeploymentConfigs -> ListDeploymentConfigs -> Bool
== :: ListDeploymentConfigs -> ListDeploymentConfigs -> Bool
$c== :: ListDeploymentConfigs -> ListDeploymentConfigs -> Bool
Prelude.Eq, ReadPrec [ListDeploymentConfigs]
ReadPrec ListDeploymentConfigs
Int -> ReadS ListDeploymentConfigs
ReadS [ListDeploymentConfigs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDeploymentConfigs]
$creadListPrec :: ReadPrec [ListDeploymentConfigs]
readPrec :: ReadPrec ListDeploymentConfigs
$creadPrec :: ReadPrec ListDeploymentConfigs
readList :: ReadS [ListDeploymentConfigs]
$creadList :: ReadS [ListDeploymentConfigs]
readsPrec :: Int -> ReadS ListDeploymentConfigs
$creadsPrec :: Int -> ReadS ListDeploymentConfigs
Prelude.Read, Int -> ListDeploymentConfigs -> ShowS
[ListDeploymentConfigs] -> ShowS
ListDeploymentConfigs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDeploymentConfigs] -> ShowS
$cshowList :: [ListDeploymentConfigs] -> ShowS
show :: ListDeploymentConfigs -> String
$cshow :: ListDeploymentConfigs -> String
showsPrec :: Int -> ListDeploymentConfigs -> ShowS
$cshowsPrec :: Int -> ListDeploymentConfigs -> ShowS
Prelude.Show, forall x. Rep ListDeploymentConfigs x -> ListDeploymentConfigs
forall x. ListDeploymentConfigs -> Rep ListDeploymentConfigs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListDeploymentConfigs x -> ListDeploymentConfigs
$cfrom :: forall x. ListDeploymentConfigs -> Rep ListDeploymentConfigs x
Prelude.Generic)

-- |
-- Create a value of 'ListDeploymentConfigs' 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', 'listDeploymentConfigs_nextToken' - An identifier returned from the previous @ListDeploymentConfigs@ call.
-- It can be used to return the next set of deployment configurations in
-- the list.
newListDeploymentConfigs ::
  ListDeploymentConfigs
newListDeploymentConfigs :: ListDeploymentConfigs
newListDeploymentConfigs =
  ListDeploymentConfigs' {$sel:nextToken:ListDeploymentConfigs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing}

-- | An identifier returned from the previous @ListDeploymentConfigs@ call.
-- It can be used to return the next set of deployment configurations in
-- the list.
listDeploymentConfigs_nextToken :: Lens.Lens' ListDeploymentConfigs (Prelude.Maybe Prelude.Text)
listDeploymentConfigs_nextToken :: Lens' ListDeploymentConfigs (Maybe Text)
listDeploymentConfigs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeploymentConfigs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDeploymentConfigs' :: ListDeploymentConfigs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDeploymentConfigs
s@ListDeploymentConfigs' {} Maybe Text
a -> ListDeploymentConfigs
s {$sel:nextToken:ListDeploymentConfigs' :: Maybe Text
nextToken = Maybe Text
a} :: ListDeploymentConfigs)

instance Core.AWSPager ListDeploymentConfigs where
  page :: ListDeploymentConfigs
-> AWSResponse ListDeploymentConfigs -> Maybe ListDeploymentConfigs
page ListDeploymentConfigs
rq AWSResponse ListDeploymentConfigs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListDeploymentConfigs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeploymentConfigsResponse (Maybe Text)
listDeploymentConfigsResponse_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 ListDeploymentConfigs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeploymentConfigsResponse (Maybe [Text])
listDeploymentConfigsResponse_deploymentConfigsList
            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.$ ListDeploymentConfigs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListDeploymentConfigs (Maybe Text)
listDeploymentConfigs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListDeploymentConfigs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeploymentConfigsResponse (Maybe Text)
listDeploymentConfigsResponse_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 ListDeploymentConfigs where
  type
    AWSResponse ListDeploymentConfigs =
      ListDeploymentConfigsResponse
  request :: (Service -> Service)
-> ListDeploymentConfigs -> Request ListDeploymentConfigs
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 ListDeploymentConfigs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListDeploymentConfigs)))
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 -> ListDeploymentConfigsResponse
ListDeploymentConfigsResponse'
            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
"deploymentConfigsList"
                            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 ListDeploymentConfigs where
  hashWithSalt :: Int -> ListDeploymentConfigs -> Int
hashWithSalt Int
_salt ListDeploymentConfigs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDeploymentConfigs' :: ListDeploymentConfigs -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListDeploymentConfigs where
  rnf :: ListDeploymentConfigs -> ()
rnf ListDeploymentConfigs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDeploymentConfigs' :: ListDeploymentConfigs -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

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

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

-- | Represents the output of a @ListDeploymentConfigs@ operation.
--
-- /See:/ 'newListDeploymentConfigsResponse' smart constructor.
data ListDeploymentConfigsResponse = ListDeploymentConfigsResponse'
  { -- | A list of deployment configurations, including built-in configurations
    -- such as @CodeDeployDefault.OneAtATime@.
    ListDeploymentConfigsResponse -> Maybe [Text]
deploymentConfigsList :: Prelude.Maybe [Prelude.Text],
    -- | If a large amount of information is returned, an identifier is also
    -- returned. It can be used in a subsequent list deployment configurations
    -- call to return the next set of deployment configurations in the list.
    ListDeploymentConfigsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListDeploymentConfigsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListDeploymentConfigsResponse
-> ListDeploymentConfigsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDeploymentConfigsResponse
-> ListDeploymentConfigsResponse -> Bool
$c/= :: ListDeploymentConfigsResponse
-> ListDeploymentConfigsResponse -> Bool
== :: ListDeploymentConfigsResponse
-> ListDeploymentConfigsResponse -> Bool
$c== :: ListDeploymentConfigsResponse
-> ListDeploymentConfigsResponse -> Bool
Prelude.Eq, ReadPrec [ListDeploymentConfigsResponse]
ReadPrec ListDeploymentConfigsResponse
Int -> ReadS ListDeploymentConfigsResponse
ReadS [ListDeploymentConfigsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDeploymentConfigsResponse]
$creadListPrec :: ReadPrec [ListDeploymentConfigsResponse]
readPrec :: ReadPrec ListDeploymentConfigsResponse
$creadPrec :: ReadPrec ListDeploymentConfigsResponse
readList :: ReadS [ListDeploymentConfigsResponse]
$creadList :: ReadS [ListDeploymentConfigsResponse]
readsPrec :: Int -> ReadS ListDeploymentConfigsResponse
$creadsPrec :: Int -> ReadS ListDeploymentConfigsResponse
Prelude.Read, Int -> ListDeploymentConfigsResponse -> ShowS
[ListDeploymentConfigsResponse] -> ShowS
ListDeploymentConfigsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDeploymentConfigsResponse] -> ShowS
$cshowList :: [ListDeploymentConfigsResponse] -> ShowS
show :: ListDeploymentConfigsResponse -> String
$cshow :: ListDeploymentConfigsResponse -> String
showsPrec :: Int -> ListDeploymentConfigsResponse -> ShowS
$cshowsPrec :: Int -> ListDeploymentConfigsResponse -> ShowS
Prelude.Show, forall x.
Rep ListDeploymentConfigsResponse x
-> ListDeploymentConfigsResponse
forall x.
ListDeploymentConfigsResponse
-> Rep ListDeploymentConfigsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListDeploymentConfigsResponse x
-> ListDeploymentConfigsResponse
$cfrom :: forall x.
ListDeploymentConfigsResponse
-> Rep ListDeploymentConfigsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListDeploymentConfigsResponse' 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:
--
-- 'deploymentConfigsList', 'listDeploymentConfigsResponse_deploymentConfigsList' - A list of deployment configurations, including built-in configurations
-- such as @CodeDeployDefault.OneAtATime@.
--
-- 'nextToken', 'listDeploymentConfigsResponse_nextToken' - If a large amount of information is returned, an identifier is also
-- returned. It can be used in a subsequent list deployment configurations
-- call to return the next set of deployment configurations in the list.
--
-- 'httpStatus', 'listDeploymentConfigsResponse_httpStatus' - The response's http status code.
newListDeploymentConfigsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListDeploymentConfigsResponse
newListDeploymentConfigsResponse :: Int -> ListDeploymentConfigsResponse
newListDeploymentConfigsResponse Int
pHttpStatus_ =
  ListDeploymentConfigsResponse'
    { $sel:deploymentConfigsList:ListDeploymentConfigsResponse' :: Maybe [Text]
deploymentConfigsList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListDeploymentConfigsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListDeploymentConfigsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of deployment configurations, including built-in configurations
-- such as @CodeDeployDefault.OneAtATime@.
listDeploymentConfigsResponse_deploymentConfigsList :: Lens.Lens' ListDeploymentConfigsResponse (Prelude.Maybe [Prelude.Text])
listDeploymentConfigsResponse_deploymentConfigsList :: Lens' ListDeploymentConfigsResponse (Maybe [Text])
listDeploymentConfigsResponse_deploymentConfigsList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeploymentConfigsResponse' {Maybe [Text]
deploymentConfigsList :: Maybe [Text]
$sel:deploymentConfigsList:ListDeploymentConfigsResponse' :: ListDeploymentConfigsResponse -> Maybe [Text]
deploymentConfigsList} -> Maybe [Text]
deploymentConfigsList) (\s :: ListDeploymentConfigsResponse
s@ListDeploymentConfigsResponse' {} Maybe [Text]
a -> ListDeploymentConfigsResponse
s {$sel:deploymentConfigsList:ListDeploymentConfigsResponse' :: Maybe [Text]
deploymentConfigsList = Maybe [Text]
a} :: ListDeploymentConfigsResponse) 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

-- | If a large amount of information is returned, an identifier is also
-- returned. It can be used in a subsequent list deployment configurations
-- call to return the next set of deployment configurations in the list.
listDeploymentConfigsResponse_nextToken :: Lens.Lens' ListDeploymentConfigsResponse (Prelude.Maybe Prelude.Text)
listDeploymentConfigsResponse_nextToken :: Lens' ListDeploymentConfigsResponse (Maybe Text)
listDeploymentConfigsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeploymentConfigsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDeploymentConfigsResponse' :: ListDeploymentConfigsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDeploymentConfigsResponse
s@ListDeploymentConfigsResponse' {} Maybe Text
a -> ListDeploymentConfigsResponse
s {$sel:nextToken:ListDeploymentConfigsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListDeploymentConfigsResponse)

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

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