{-# 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.BatchGetDeploymentTargets
-- 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 an array of one or more targets associated with a deployment.
-- This method works with all compute types and should be used instead of
-- the deprecated @BatchGetDeploymentInstances@. The maximum number of
-- targets that can be returned is 25.
--
-- The type of targets returned depends on the deployment\'s compute
-- platform or deployment method:
--
-- -   __EC2\/On-premises__: Information about Amazon EC2 instance targets.
--
-- -   __Lambda__: Information about Lambda functions targets.
--
-- -   __Amazon ECS__: Information about Amazon ECS service targets.
--
-- -   __CloudFormation__: Information about targets of blue\/green
--     deployments initiated by a CloudFormation stack update.
module Amazonka.CodeDeploy.BatchGetDeploymentTargets
  ( -- * Creating a Request
    BatchGetDeploymentTargets (..),
    newBatchGetDeploymentTargets,

    -- * Request Lenses
    batchGetDeploymentTargets_deploymentId,
    batchGetDeploymentTargets_targetIds,

    -- * Destructuring the Response
    BatchGetDeploymentTargetsResponse (..),
    newBatchGetDeploymentTargetsResponse,

    -- * Response Lenses
    batchGetDeploymentTargetsResponse_deploymentTargets,
    batchGetDeploymentTargetsResponse_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

-- | /See:/ 'newBatchGetDeploymentTargets' smart constructor.
data BatchGetDeploymentTargets = BatchGetDeploymentTargets'
  { -- | The unique ID of a deployment.
    BatchGetDeploymentTargets -> Maybe Text
deploymentId :: Prelude.Maybe Prelude.Text,
    -- | The unique IDs of the deployment targets. The compute platform of the
    -- deployment determines the type of the targets and their formats. The
    -- maximum number of deployment target IDs you can specify is 25.
    --
    -- -   For deployments that use the EC2\/On-premises compute platform, the
    --     target IDs are Amazon EC2 or on-premises instances IDs, and their
    --     target type is @instanceTarget@.
    --
    -- -   For deployments that use the Lambda compute platform, the target IDs
    --     are the names of Lambda functions, and their target type is
    --     @instanceTarget@.
    --
    -- -   For deployments that use the Amazon ECS compute platform, the target
    --     IDs are pairs of Amazon ECS clusters and services specified using
    --     the format @\<clustername>:\<servicename>@. Their target type is
    --     @ecsTarget@.
    --
    -- -   For deployments that are deployed with CloudFormation, the target
    --     IDs are CloudFormation stack IDs. Their target type is
    --     @cloudFormationTarget@.
    BatchGetDeploymentTargets -> Maybe [Text]
targetIds :: Prelude.Maybe [Prelude.Text]
  }
  deriving (BatchGetDeploymentTargets -> BatchGetDeploymentTargets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDeploymentTargets -> BatchGetDeploymentTargets -> Bool
$c/= :: BatchGetDeploymentTargets -> BatchGetDeploymentTargets -> Bool
== :: BatchGetDeploymentTargets -> BatchGetDeploymentTargets -> Bool
$c== :: BatchGetDeploymentTargets -> BatchGetDeploymentTargets -> Bool
Prelude.Eq, ReadPrec [BatchGetDeploymentTargets]
ReadPrec BatchGetDeploymentTargets
Int -> ReadS BatchGetDeploymentTargets
ReadS [BatchGetDeploymentTargets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDeploymentTargets]
$creadListPrec :: ReadPrec [BatchGetDeploymentTargets]
readPrec :: ReadPrec BatchGetDeploymentTargets
$creadPrec :: ReadPrec BatchGetDeploymentTargets
readList :: ReadS [BatchGetDeploymentTargets]
$creadList :: ReadS [BatchGetDeploymentTargets]
readsPrec :: Int -> ReadS BatchGetDeploymentTargets
$creadsPrec :: Int -> ReadS BatchGetDeploymentTargets
Prelude.Read, Int -> BatchGetDeploymentTargets -> ShowS
[BatchGetDeploymentTargets] -> ShowS
BatchGetDeploymentTargets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDeploymentTargets] -> ShowS
$cshowList :: [BatchGetDeploymentTargets] -> ShowS
show :: BatchGetDeploymentTargets -> String
$cshow :: BatchGetDeploymentTargets -> String
showsPrec :: Int -> BatchGetDeploymentTargets -> ShowS
$cshowsPrec :: Int -> BatchGetDeploymentTargets -> ShowS
Prelude.Show, forall x.
Rep BatchGetDeploymentTargets x -> BatchGetDeploymentTargets
forall x.
BatchGetDeploymentTargets -> Rep BatchGetDeploymentTargets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetDeploymentTargets x -> BatchGetDeploymentTargets
$cfrom :: forall x.
BatchGetDeploymentTargets -> Rep BatchGetDeploymentTargets x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDeploymentTargets' 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:
--
-- 'deploymentId', 'batchGetDeploymentTargets_deploymentId' - The unique ID of a deployment.
--
-- 'targetIds', 'batchGetDeploymentTargets_targetIds' - The unique IDs of the deployment targets. The compute platform of the
-- deployment determines the type of the targets and their formats. The
-- maximum number of deployment target IDs you can specify is 25.
--
-- -   For deployments that use the EC2\/On-premises compute platform, the
--     target IDs are Amazon EC2 or on-premises instances IDs, and their
--     target type is @instanceTarget@.
--
-- -   For deployments that use the Lambda compute platform, the target IDs
--     are the names of Lambda functions, and their target type is
--     @instanceTarget@.
--
-- -   For deployments that use the Amazon ECS compute platform, the target
--     IDs are pairs of Amazon ECS clusters and services specified using
--     the format @\<clustername>:\<servicename>@. Their target type is
--     @ecsTarget@.
--
-- -   For deployments that are deployed with CloudFormation, the target
--     IDs are CloudFormation stack IDs. Their target type is
--     @cloudFormationTarget@.
newBatchGetDeploymentTargets ::
  BatchGetDeploymentTargets
newBatchGetDeploymentTargets :: BatchGetDeploymentTargets
newBatchGetDeploymentTargets =
  BatchGetDeploymentTargets'
    { $sel:deploymentId:BatchGetDeploymentTargets' :: Maybe Text
deploymentId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:targetIds:BatchGetDeploymentTargets' :: Maybe [Text]
targetIds = forall a. Maybe a
Prelude.Nothing
    }

-- | The unique ID of a deployment.
batchGetDeploymentTargets_deploymentId :: Lens.Lens' BatchGetDeploymentTargets (Prelude.Maybe Prelude.Text)
batchGetDeploymentTargets_deploymentId :: Lens' BatchGetDeploymentTargets (Maybe Text)
batchGetDeploymentTargets_deploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentTargets' {Maybe Text
deploymentId :: Maybe Text
$sel:deploymentId:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe Text
deploymentId} -> Maybe Text
deploymentId) (\s :: BatchGetDeploymentTargets
s@BatchGetDeploymentTargets' {} Maybe Text
a -> BatchGetDeploymentTargets
s {$sel:deploymentId:BatchGetDeploymentTargets' :: Maybe Text
deploymentId = Maybe Text
a} :: BatchGetDeploymentTargets)

-- | The unique IDs of the deployment targets. The compute platform of the
-- deployment determines the type of the targets and their formats. The
-- maximum number of deployment target IDs you can specify is 25.
--
-- -   For deployments that use the EC2\/On-premises compute platform, the
--     target IDs are Amazon EC2 or on-premises instances IDs, and their
--     target type is @instanceTarget@.
--
-- -   For deployments that use the Lambda compute platform, the target IDs
--     are the names of Lambda functions, and their target type is
--     @instanceTarget@.
--
-- -   For deployments that use the Amazon ECS compute platform, the target
--     IDs are pairs of Amazon ECS clusters and services specified using
--     the format @\<clustername>:\<servicename>@. Their target type is
--     @ecsTarget@.
--
-- -   For deployments that are deployed with CloudFormation, the target
--     IDs are CloudFormation stack IDs. Their target type is
--     @cloudFormationTarget@.
batchGetDeploymentTargets_targetIds :: Lens.Lens' BatchGetDeploymentTargets (Prelude.Maybe [Prelude.Text])
batchGetDeploymentTargets_targetIds :: Lens' BatchGetDeploymentTargets (Maybe [Text])
batchGetDeploymentTargets_targetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentTargets' {Maybe [Text]
targetIds :: Maybe [Text]
$sel:targetIds:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe [Text]
targetIds} -> Maybe [Text]
targetIds) (\s :: BatchGetDeploymentTargets
s@BatchGetDeploymentTargets' {} Maybe [Text]
a -> BatchGetDeploymentTargets
s {$sel:targetIds:BatchGetDeploymentTargets' :: Maybe [Text]
targetIds = Maybe [Text]
a} :: BatchGetDeploymentTargets) 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.AWSRequest BatchGetDeploymentTargets where
  type
    AWSResponse BatchGetDeploymentTargets =
      BatchGetDeploymentTargetsResponse
  request :: (Service -> Service)
-> BatchGetDeploymentTargets -> Request BatchGetDeploymentTargets
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 BatchGetDeploymentTargets
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetDeploymentTargets)))
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 [DeploymentTarget]
-> Int -> BatchGetDeploymentTargetsResponse
BatchGetDeploymentTargetsResponse'
            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
"deploymentTargets"
                            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 BatchGetDeploymentTargets where
  hashWithSalt :: Int -> BatchGetDeploymentTargets -> Int
hashWithSalt Int
_salt BatchGetDeploymentTargets' {Maybe [Text]
Maybe Text
targetIds :: Maybe [Text]
deploymentId :: Maybe Text
$sel:targetIds:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe [Text]
$sel:deploymentId:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deploymentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
targetIds

instance Prelude.NFData BatchGetDeploymentTargets where
  rnf :: BatchGetDeploymentTargets -> ()
rnf BatchGetDeploymentTargets' {Maybe [Text]
Maybe Text
targetIds :: Maybe [Text]
deploymentId :: Maybe Text
$sel:targetIds:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe [Text]
$sel:deploymentId:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deploymentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
targetIds

instance Data.ToHeaders BatchGetDeploymentTargets where
  toHeaders :: BatchGetDeploymentTargets -> 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.BatchGetDeploymentTargets" ::
                          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 BatchGetDeploymentTargets where
  toJSON :: BatchGetDeploymentTargets -> Value
toJSON BatchGetDeploymentTargets' {Maybe [Text]
Maybe Text
targetIds :: Maybe [Text]
deploymentId :: Maybe Text
$sel:targetIds:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe [Text]
$sel:deploymentId:BatchGetDeploymentTargets' :: BatchGetDeploymentTargets -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"deploymentId" 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
deploymentId,
            (Key
"targetIds" 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]
targetIds
          ]
      )

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

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

-- | /See:/ 'newBatchGetDeploymentTargetsResponse' smart constructor.
data BatchGetDeploymentTargetsResponse = BatchGetDeploymentTargetsResponse'
  { -- | A list of target objects for a deployment. Each target object contains
    -- details about the target, such as its status and lifecycle events. The
    -- type of the target objects depends on the deployment\' compute platform.
    --
    -- -   __EC2\/On-premises__: Each target object is an Amazon EC2 or
    --     on-premises instance.
    --
    -- -   __Lambda__: The target object is a specific version of an Lambda
    --     function.
    --
    -- -   __Amazon ECS__: The target object is an Amazon ECS service.
    --
    -- -   __CloudFormation__: The target object is an CloudFormation
    --     blue\/green deployment.
    BatchGetDeploymentTargetsResponse -> Maybe [DeploymentTarget]
deploymentTargets :: Prelude.Maybe [DeploymentTarget],
    -- | The response's http status code.
    BatchGetDeploymentTargetsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetDeploymentTargetsResponse
-> BatchGetDeploymentTargetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDeploymentTargetsResponse
-> BatchGetDeploymentTargetsResponse -> Bool
$c/= :: BatchGetDeploymentTargetsResponse
-> BatchGetDeploymentTargetsResponse -> Bool
== :: BatchGetDeploymentTargetsResponse
-> BatchGetDeploymentTargetsResponse -> Bool
$c== :: BatchGetDeploymentTargetsResponse
-> BatchGetDeploymentTargetsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetDeploymentTargetsResponse]
ReadPrec BatchGetDeploymentTargetsResponse
Int -> ReadS BatchGetDeploymentTargetsResponse
ReadS [BatchGetDeploymentTargetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDeploymentTargetsResponse]
$creadListPrec :: ReadPrec [BatchGetDeploymentTargetsResponse]
readPrec :: ReadPrec BatchGetDeploymentTargetsResponse
$creadPrec :: ReadPrec BatchGetDeploymentTargetsResponse
readList :: ReadS [BatchGetDeploymentTargetsResponse]
$creadList :: ReadS [BatchGetDeploymentTargetsResponse]
readsPrec :: Int -> ReadS BatchGetDeploymentTargetsResponse
$creadsPrec :: Int -> ReadS BatchGetDeploymentTargetsResponse
Prelude.Read, Int -> BatchGetDeploymentTargetsResponse -> ShowS
[BatchGetDeploymentTargetsResponse] -> ShowS
BatchGetDeploymentTargetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDeploymentTargetsResponse] -> ShowS
$cshowList :: [BatchGetDeploymentTargetsResponse] -> ShowS
show :: BatchGetDeploymentTargetsResponse -> String
$cshow :: BatchGetDeploymentTargetsResponse -> String
showsPrec :: Int -> BatchGetDeploymentTargetsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetDeploymentTargetsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetDeploymentTargetsResponse x
-> BatchGetDeploymentTargetsResponse
forall x.
BatchGetDeploymentTargetsResponse
-> Rep BatchGetDeploymentTargetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetDeploymentTargetsResponse x
-> BatchGetDeploymentTargetsResponse
$cfrom :: forall x.
BatchGetDeploymentTargetsResponse
-> Rep BatchGetDeploymentTargetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDeploymentTargetsResponse' 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:
--
-- 'deploymentTargets', 'batchGetDeploymentTargetsResponse_deploymentTargets' - A list of target objects for a deployment. Each target object contains
-- details about the target, such as its status and lifecycle events. The
-- type of the target objects depends on the deployment\' compute platform.
--
-- -   __EC2\/On-premises__: Each target object is an Amazon EC2 or
--     on-premises instance.
--
-- -   __Lambda__: The target object is a specific version of an Lambda
--     function.
--
-- -   __Amazon ECS__: The target object is an Amazon ECS service.
--
-- -   __CloudFormation__: The target object is an CloudFormation
--     blue\/green deployment.
--
-- 'httpStatus', 'batchGetDeploymentTargetsResponse_httpStatus' - The response's http status code.
newBatchGetDeploymentTargetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetDeploymentTargetsResponse
newBatchGetDeploymentTargetsResponse :: Int -> BatchGetDeploymentTargetsResponse
newBatchGetDeploymentTargetsResponse Int
pHttpStatus_ =
  BatchGetDeploymentTargetsResponse'
    { $sel:deploymentTargets:BatchGetDeploymentTargetsResponse' :: Maybe [DeploymentTarget]
deploymentTargets =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetDeploymentTargetsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of target objects for a deployment. Each target object contains
-- details about the target, such as its status and lifecycle events. The
-- type of the target objects depends on the deployment\' compute platform.
--
-- -   __EC2\/On-premises__: Each target object is an Amazon EC2 or
--     on-premises instance.
--
-- -   __Lambda__: The target object is a specific version of an Lambda
--     function.
--
-- -   __Amazon ECS__: The target object is an Amazon ECS service.
--
-- -   __CloudFormation__: The target object is an CloudFormation
--     blue\/green deployment.
batchGetDeploymentTargetsResponse_deploymentTargets :: Lens.Lens' BatchGetDeploymentTargetsResponse (Prelude.Maybe [DeploymentTarget])
batchGetDeploymentTargetsResponse_deploymentTargets :: Lens' BatchGetDeploymentTargetsResponse (Maybe [DeploymentTarget])
batchGetDeploymentTargetsResponse_deploymentTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentTargetsResponse' {Maybe [DeploymentTarget]
deploymentTargets :: Maybe [DeploymentTarget]
$sel:deploymentTargets:BatchGetDeploymentTargetsResponse' :: BatchGetDeploymentTargetsResponse -> Maybe [DeploymentTarget]
deploymentTargets} -> Maybe [DeploymentTarget]
deploymentTargets) (\s :: BatchGetDeploymentTargetsResponse
s@BatchGetDeploymentTargetsResponse' {} Maybe [DeploymentTarget]
a -> BatchGetDeploymentTargetsResponse
s {$sel:deploymentTargets:BatchGetDeploymentTargetsResponse' :: Maybe [DeploymentTarget]
deploymentTargets = Maybe [DeploymentTarget]
a} :: BatchGetDeploymentTargetsResponse) 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.
batchGetDeploymentTargetsResponse_httpStatus :: Lens.Lens' BatchGetDeploymentTargetsResponse Prelude.Int
batchGetDeploymentTargetsResponse_httpStatus :: Lens' BatchGetDeploymentTargetsResponse Int
batchGetDeploymentTargetsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentTargetsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetDeploymentTargetsResponse' :: BatchGetDeploymentTargetsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetDeploymentTargetsResponse
s@BatchGetDeploymentTargetsResponse' {} Int
a -> BatchGetDeploymentTargetsResponse
s {$sel:httpStatus:BatchGetDeploymentTargetsResponse' :: Int
httpStatus = Int
a} :: BatchGetDeploymentTargetsResponse)

instance
  Prelude.NFData
    BatchGetDeploymentTargetsResponse
  where
  rnf :: BatchGetDeploymentTargetsResponse -> ()
rnf BatchGetDeploymentTargetsResponse' {Int
Maybe [DeploymentTarget]
httpStatus :: Int
deploymentTargets :: Maybe [DeploymentTarget]
$sel:httpStatus:BatchGetDeploymentTargetsResponse' :: BatchGetDeploymentTargetsResponse -> Int
$sel:deploymentTargets:BatchGetDeploymentTargetsResponse' :: BatchGetDeploymentTargetsResponse -> Maybe [DeploymentTarget]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DeploymentTarget]
deploymentTargets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus