{-# 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.BatchGetDeploymentGroups
-- 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 one or more deployment groups.
module Amazonka.CodeDeploy.BatchGetDeploymentGroups
  ( -- * Creating a Request
    BatchGetDeploymentGroups (..),
    newBatchGetDeploymentGroups,

    -- * Request Lenses
    batchGetDeploymentGroups_applicationName,
    batchGetDeploymentGroups_deploymentGroupNames,

    -- * Destructuring the Response
    BatchGetDeploymentGroupsResponse (..),
    newBatchGetDeploymentGroupsResponse,

    -- * Response Lenses
    batchGetDeploymentGroupsResponse_deploymentGroupsInfo,
    batchGetDeploymentGroupsResponse_errorMessage,
    batchGetDeploymentGroupsResponse_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 @BatchGetDeploymentGroups@ operation.
--
-- /See:/ 'newBatchGetDeploymentGroups' smart constructor.
data BatchGetDeploymentGroups = BatchGetDeploymentGroups'
  { -- | The name of an CodeDeploy application associated with the applicable IAM
    -- or Amazon Web Services account.
    BatchGetDeploymentGroups -> Text
applicationName :: Prelude.Text,
    -- | The names of the deployment groups.
    BatchGetDeploymentGroups -> [Text]
deploymentGroupNames :: [Prelude.Text]
  }
  deriving (BatchGetDeploymentGroups -> BatchGetDeploymentGroups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDeploymentGroups -> BatchGetDeploymentGroups -> Bool
$c/= :: BatchGetDeploymentGroups -> BatchGetDeploymentGroups -> Bool
== :: BatchGetDeploymentGroups -> BatchGetDeploymentGroups -> Bool
$c== :: BatchGetDeploymentGroups -> BatchGetDeploymentGroups -> Bool
Prelude.Eq, ReadPrec [BatchGetDeploymentGroups]
ReadPrec BatchGetDeploymentGroups
Int -> ReadS BatchGetDeploymentGroups
ReadS [BatchGetDeploymentGroups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDeploymentGroups]
$creadListPrec :: ReadPrec [BatchGetDeploymentGroups]
readPrec :: ReadPrec BatchGetDeploymentGroups
$creadPrec :: ReadPrec BatchGetDeploymentGroups
readList :: ReadS [BatchGetDeploymentGroups]
$creadList :: ReadS [BatchGetDeploymentGroups]
readsPrec :: Int -> ReadS BatchGetDeploymentGroups
$creadsPrec :: Int -> ReadS BatchGetDeploymentGroups
Prelude.Read, Int -> BatchGetDeploymentGroups -> ShowS
[BatchGetDeploymentGroups] -> ShowS
BatchGetDeploymentGroups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDeploymentGroups] -> ShowS
$cshowList :: [BatchGetDeploymentGroups] -> ShowS
show :: BatchGetDeploymentGroups -> String
$cshow :: BatchGetDeploymentGroups -> String
showsPrec :: Int -> BatchGetDeploymentGroups -> ShowS
$cshowsPrec :: Int -> BatchGetDeploymentGroups -> ShowS
Prelude.Show, forall x.
Rep BatchGetDeploymentGroups x -> BatchGetDeploymentGroups
forall x.
BatchGetDeploymentGroups -> Rep BatchGetDeploymentGroups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetDeploymentGroups x -> BatchGetDeploymentGroups
$cfrom :: forall x.
BatchGetDeploymentGroups -> Rep BatchGetDeploymentGroups x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDeploymentGroups' 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:
--
-- 'applicationName', 'batchGetDeploymentGroups_applicationName' - The name of an CodeDeploy application associated with the applicable IAM
-- or Amazon Web Services account.
--
-- 'deploymentGroupNames', 'batchGetDeploymentGroups_deploymentGroupNames' - The names of the deployment groups.
newBatchGetDeploymentGroups ::
  -- | 'applicationName'
  Prelude.Text ->
  BatchGetDeploymentGroups
newBatchGetDeploymentGroups :: Text -> BatchGetDeploymentGroups
newBatchGetDeploymentGroups Text
pApplicationName_ =
  BatchGetDeploymentGroups'
    { $sel:applicationName:BatchGetDeploymentGroups' :: Text
applicationName =
        Text
pApplicationName_,
      $sel:deploymentGroupNames:BatchGetDeploymentGroups' :: [Text]
deploymentGroupNames = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of an CodeDeploy application associated with the applicable IAM
-- or Amazon Web Services account.
batchGetDeploymentGroups_applicationName :: Lens.Lens' BatchGetDeploymentGroups Prelude.Text
batchGetDeploymentGroups_applicationName :: Lens' BatchGetDeploymentGroups Text
batchGetDeploymentGroups_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentGroups' {Text
applicationName :: Text
$sel:applicationName:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> Text
applicationName} -> Text
applicationName) (\s :: BatchGetDeploymentGroups
s@BatchGetDeploymentGroups' {} Text
a -> BatchGetDeploymentGroups
s {$sel:applicationName:BatchGetDeploymentGroups' :: Text
applicationName = Text
a} :: BatchGetDeploymentGroups)

-- | The names of the deployment groups.
batchGetDeploymentGroups_deploymentGroupNames :: Lens.Lens' BatchGetDeploymentGroups [Prelude.Text]
batchGetDeploymentGroups_deploymentGroupNames :: Lens' BatchGetDeploymentGroups [Text]
batchGetDeploymentGroups_deploymentGroupNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentGroups' {[Text]
deploymentGroupNames :: [Text]
$sel:deploymentGroupNames:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> [Text]
deploymentGroupNames} -> [Text]
deploymentGroupNames) (\s :: BatchGetDeploymentGroups
s@BatchGetDeploymentGroups' {} [Text]
a -> BatchGetDeploymentGroups
s {$sel:deploymentGroupNames:BatchGetDeploymentGroups' :: [Text]
deploymentGroupNames = [Text]
a} :: BatchGetDeploymentGroups) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchGetDeploymentGroups where
  type
    AWSResponse BatchGetDeploymentGroups =
      BatchGetDeploymentGroupsResponse
  request :: (Service -> Service)
-> BatchGetDeploymentGroups -> Request BatchGetDeploymentGroups
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 BatchGetDeploymentGroups
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetDeploymentGroups)))
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 [DeploymentGroupInfo]
-> Maybe Text -> Int -> BatchGetDeploymentGroupsResponse
BatchGetDeploymentGroupsResponse'
            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
"deploymentGroupsInfo"
                            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
"errorMessage")
            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 BatchGetDeploymentGroups where
  hashWithSalt :: Int -> BatchGetDeploymentGroups -> Int
hashWithSalt Int
_salt BatchGetDeploymentGroups' {[Text]
Text
deploymentGroupNames :: [Text]
applicationName :: Text
$sel:deploymentGroupNames:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> [Text]
$sel:applicationName:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
deploymentGroupNames

instance Prelude.NFData BatchGetDeploymentGroups where
  rnf :: BatchGetDeploymentGroups -> ()
rnf BatchGetDeploymentGroups' {[Text]
Text
deploymentGroupNames :: [Text]
applicationName :: Text
$sel:deploymentGroupNames:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> [Text]
$sel:applicationName:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
deploymentGroupNames

instance Data.ToHeaders BatchGetDeploymentGroups where
  toHeaders :: BatchGetDeploymentGroups -> 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.BatchGetDeploymentGroups" ::
                          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 BatchGetDeploymentGroups where
  toJSON :: BatchGetDeploymentGroups -> Value
toJSON BatchGetDeploymentGroups' {[Text]
Text
deploymentGroupNames :: [Text]
applicationName :: Text
$sel:deploymentGroupNames:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> [Text]
$sel:applicationName:BatchGetDeploymentGroups' :: BatchGetDeploymentGroups -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"applicationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
applicationName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"deploymentGroupNames"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
deploymentGroupNames
              )
          ]
      )

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

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

-- | Represents the output of a @BatchGetDeploymentGroups@ operation.
--
-- /See:/ 'newBatchGetDeploymentGroupsResponse' smart constructor.
data BatchGetDeploymentGroupsResponse = BatchGetDeploymentGroupsResponse'
  { -- | Information about the deployment groups.
    BatchGetDeploymentGroupsResponse -> Maybe [DeploymentGroupInfo]
deploymentGroupsInfo :: Prelude.Maybe [DeploymentGroupInfo],
    -- | Information about errors that might have occurred during the API call.
    BatchGetDeploymentGroupsResponse -> Maybe Text
errorMessage :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    BatchGetDeploymentGroupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetDeploymentGroupsResponse
-> BatchGetDeploymentGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDeploymentGroupsResponse
-> BatchGetDeploymentGroupsResponse -> Bool
$c/= :: BatchGetDeploymentGroupsResponse
-> BatchGetDeploymentGroupsResponse -> Bool
== :: BatchGetDeploymentGroupsResponse
-> BatchGetDeploymentGroupsResponse -> Bool
$c== :: BatchGetDeploymentGroupsResponse
-> BatchGetDeploymentGroupsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetDeploymentGroupsResponse]
ReadPrec BatchGetDeploymentGroupsResponse
Int -> ReadS BatchGetDeploymentGroupsResponse
ReadS [BatchGetDeploymentGroupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDeploymentGroupsResponse]
$creadListPrec :: ReadPrec [BatchGetDeploymentGroupsResponse]
readPrec :: ReadPrec BatchGetDeploymentGroupsResponse
$creadPrec :: ReadPrec BatchGetDeploymentGroupsResponse
readList :: ReadS [BatchGetDeploymentGroupsResponse]
$creadList :: ReadS [BatchGetDeploymentGroupsResponse]
readsPrec :: Int -> ReadS BatchGetDeploymentGroupsResponse
$creadsPrec :: Int -> ReadS BatchGetDeploymentGroupsResponse
Prelude.Read, Int -> BatchGetDeploymentGroupsResponse -> ShowS
[BatchGetDeploymentGroupsResponse] -> ShowS
BatchGetDeploymentGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDeploymentGroupsResponse] -> ShowS
$cshowList :: [BatchGetDeploymentGroupsResponse] -> ShowS
show :: BatchGetDeploymentGroupsResponse -> String
$cshow :: BatchGetDeploymentGroupsResponse -> String
showsPrec :: Int -> BatchGetDeploymentGroupsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetDeploymentGroupsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetDeploymentGroupsResponse x
-> BatchGetDeploymentGroupsResponse
forall x.
BatchGetDeploymentGroupsResponse
-> Rep BatchGetDeploymentGroupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetDeploymentGroupsResponse x
-> BatchGetDeploymentGroupsResponse
$cfrom :: forall x.
BatchGetDeploymentGroupsResponse
-> Rep BatchGetDeploymentGroupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDeploymentGroupsResponse' 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:
--
-- 'deploymentGroupsInfo', 'batchGetDeploymentGroupsResponse_deploymentGroupsInfo' - Information about the deployment groups.
--
-- 'errorMessage', 'batchGetDeploymentGroupsResponse_errorMessage' - Information about errors that might have occurred during the API call.
--
-- 'httpStatus', 'batchGetDeploymentGroupsResponse_httpStatus' - The response's http status code.
newBatchGetDeploymentGroupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetDeploymentGroupsResponse
newBatchGetDeploymentGroupsResponse :: Int -> BatchGetDeploymentGroupsResponse
newBatchGetDeploymentGroupsResponse Int
pHttpStatus_ =
  BatchGetDeploymentGroupsResponse'
    { $sel:deploymentGroupsInfo:BatchGetDeploymentGroupsResponse' :: Maybe [DeploymentGroupInfo]
deploymentGroupsInfo =
        forall a. Maybe a
Prelude.Nothing,
      $sel:errorMessage:BatchGetDeploymentGroupsResponse' :: Maybe Text
errorMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetDeploymentGroupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the deployment groups.
batchGetDeploymentGroupsResponse_deploymentGroupsInfo :: Lens.Lens' BatchGetDeploymentGroupsResponse (Prelude.Maybe [DeploymentGroupInfo])
batchGetDeploymentGroupsResponse_deploymentGroupsInfo :: Lens'
  BatchGetDeploymentGroupsResponse (Maybe [DeploymentGroupInfo])
batchGetDeploymentGroupsResponse_deploymentGroupsInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentGroupsResponse' {Maybe [DeploymentGroupInfo]
deploymentGroupsInfo :: Maybe [DeploymentGroupInfo]
$sel:deploymentGroupsInfo:BatchGetDeploymentGroupsResponse' :: BatchGetDeploymentGroupsResponse -> Maybe [DeploymentGroupInfo]
deploymentGroupsInfo} -> Maybe [DeploymentGroupInfo]
deploymentGroupsInfo) (\s :: BatchGetDeploymentGroupsResponse
s@BatchGetDeploymentGroupsResponse' {} Maybe [DeploymentGroupInfo]
a -> BatchGetDeploymentGroupsResponse
s {$sel:deploymentGroupsInfo:BatchGetDeploymentGroupsResponse' :: Maybe [DeploymentGroupInfo]
deploymentGroupsInfo = Maybe [DeploymentGroupInfo]
a} :: BatchGetDeploymentGroupsResponse) 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

-- | Information about errors that might have occurred during the API call.
batchGetDeploymentGroupsResponse_errorMessage :: Lens.Lens' BatchGetDeploymentGroupsResponse (Prelude.Maybe Prelude.Text)
batchGetDeploymentGroupsResponse_errorMessage :: Lens' BatchGetDeploymentGroupsResponse (Maybe Text)
batchGetDeploymentGroupsResponse_errorMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDeploymentGroupsResponse' {Maybe Text
errorMessage :: Maybe Text
$sel:errorMessage:BatchGetDeploymentGroupsResponse' :: BatchGetDeploymentGroupsResponse -> Maybe Text
errorMessage} -> Maybe Text
errorMessage) (\s :: BatchGetDeploymentGroupsResponse
s@BatchGetDeploymentGroupsResponse' {} Maybe Text
a -> BatchGetDeploymentGroupsResponse
s {$sel:errorMessage:BatchGetDeploymentGroupsResponse' :: Maybe Text
errorMessage = Maybe Text
a} :: BatchGetDeploymentGroupsResponse)

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

instance
  Prelude.NFData
    BatchGetDeploymentGroupsResponse
  where
  rnf :: BatchGetDeploymentGroupsResponse -> ()
rnf BatchGetDeploymentGroupsResponse' {Int
Maybe [DeploymentGroupInfo]
Maybe Text
httpStatus :: Int
errorMessage :: Maybe Text
deploymentGroupsInfo :: Maybe [DeploymentGroupInfo]
$sel:httpStatus:BatchGetDeploymentGroupsResponse' :: BatchGetDeploymentGroupsResponse -> Int
$sel:errorMessage:BatchGetDeploymentGroupsResponse' :: BatchGetDeploymentGroupsResponse -> Maybe Text
$sel:deploymentGroupsInfo:BatchGetDeploymentGroupsResponse' :: BatchGetDeploymentGroupsResponse -> Maybe [DeploymentGroupInfo]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DeploymentGroupInfo]
deploymentGroupsInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
errorMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus