{-# 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.Greengrass.StartBulkDeployment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deploys multiple groups in one operation. This action starts the bulk
-- deployment of a specified set of group versions. Each group version
-- deployment will be triggered with an adaptive rate that has a fixed
-- upper limit. We recommend that you include an
-- \'\'X-Amzn-Client-Token\'\' token in every \'\'StartBulkDeployment\'\'
-- request. These requests are idempotent with respect to the token and the
-- request parameters.
module Amazonka.Greengrass.StartBulkDeployment
  ( -- * Creating a Request
    StartBulkDeployment (..),
    newStartBulkDeployment,

    -- * Request Lenses
    startBulkDeployment_amznClientToken,
    startBulkDeployment_tags,
    startBulkDeployment_executionRoleArn,
    startBulkDeployment_inputFileUri,

    -- * Destructuring the Response
    StartBulkDeploymentResponse (..),
    newStartBulkDeploymentResponse,

    -- * Response Lenses
    startBulkDeploymentResponse_bulkDeploymentArn,
    startBulkDeploymentResponse_bulkDeploymentId,
    startBulkDeploymentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartBulkDeployment' smart constructor.
data StartBulkDeployment = StartBulkDeployment'
  { -- | A client token used to correlate requests and responses.
    StartBulkDeployment -> Maybe Text
amznClientToken :: Prelude.Maybe Prelude.Text,
    -- | Tag(s) to add to the new resource.
    StartBulkDeployment -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ARN of the execution role to associate with the bulk deployment
    -- operation. This IAM role must allow the
    -- \'\'greengrass:CreateDeployment\'\' action for all group versions that
    -- are listed in the input file. This IAM role must have access to the S3
    -- bucket containing the input file.
    StartBulkDeployment -> Text
executionRoleArn :: Prelude.Text,
    -- | The URI of the input file contained in the S3 bucket. The execution role
    -- must have \'\'getObject\'\' permissions on this bucket to access the
    -- input file. The input file is a JSON-serialized, line delimited file
    -- with UTF-8 encoding that provides a list of group and version IDs and
    -- the deployment type. This file must be less than 100 MB. Currently, AWS
    -- IoT Greengrass supports only \'\'NewDeployment\'\' deployment types.
    StartBulkDeployment -> Text
inputFileUri :: Prelude.Text
  }
  deriving (StartBulkDeployment -> StartBulkDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBulkDeployment -> StartBulkDeployment -> Bool
$c/= :: StartBulkDeployment -> StartBulkDeployment -> Bool
== :: StartBulkDeployment -> StartBulkDeployment -> Bool
$c== :: StartBulkDeployment -> StartBulkDeployment -> Bool
Prelude.Eq, ReadPrec [StartBulkDeployment]
ReadPrec StartBulkDeployment
Int -> ReadS StartBulkDeployment
ReadS [StartBulkDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartBulkDeployment]
$creadListPrec :: ReadPrec [StartBulkDeployment]
readPrec :: ReadPrec StartBulkDeployment
$creadPrec :: ReadPrec StartBulkDeployment
readList :: ReadS [StartBulkDeployment]
$creadList :: ReadS [StartBulkDeployment]
readsPrec :: Int -> ReadS StartBulkDeployment
$creadsPrec :: Int -> ReadS StartBulkDeployment
Prelude.Read, Int -> StartBulkDeployment -> ShowS
[StartBulkDeployment] -> ShowS
StartBulkDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBulkDeployment] -> ShowS
$cshowList :: [StartBulkDeployment] -> ShowS
show :: StartBulkDeployment -> String
$cshow :: StartBulkDeployment -> String
showsPrec :: Int -> StartBulkDeployment -> ShowS
$cshowsPrec :: Int -> StartBulkDeployment -> ShowS
Prelude.Show, forall x. Rep StartBulkDeployment x -> StartBulkDeployment
forall x. StartBulkDeployment -> Rep StartBulkDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartBulkDeployment x -> StartBulkDeployment
$cfrom :: forall x. StartBulkDeployment -> Rep StartBulkDeployment x
Prelude.Generic)

-- |
-- Create a value of 'StartBulkDeployment' 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:
--
-- 'amznClientToken', 'startBulkDeployment_amznClientToken' - A client token used to correlate requests and responses.
--
-- 'tags', 'startBulkDeployment_tags' - Tag(s) to add to the new resource.
--
-- 'executionRoleArn', 'startBulkDeployment_executionRoleArn' - The ARN of the execution role to associate with the bulk deployment
-- operation. This IAM role must allow the
-- \'\'greengrass:CreateDeployment\'\' action for all group versions that
-- are listed in the input file. This IAM role must have access to the S3
-- bucket containing the input file.
--
-- 'inputFileUri', 'startBulkDeployment_inputFileUri' - The URI of the input file contained in the S3 bucket. The execution role
-- must have \'\'getObject\'\' permissions on this bucket to access the
-- input file. The input file is a JSON-serialized, line delimited file
-- with UTF-8 encoding that provides a list of group and version IDs and
-- the deployment type. This file must be less than 100 MB. Currently, AWS
-- IoT Greengrass supports only \'\'NewDeployment\'\' deployment types.
newStartBulkDeployment ::
  -- | 'executionRoleArn'
  Prelude.Text ->
  -- | 'inputFileUri'
  Prelude.Text ->
  StartBulkDeployment
newStartBulkDeployment :: Text -> Text -> StartBulkDeployment
newStartBulkDeployment
  Text
pExecutionRoleArn_
  Text
pInputFileUri_ =
    StartBulkDeployment'
      { $sel:amznClientToken:StartBulkDeployment' :: Maybe Text
amznClientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:StartBulkDeployment' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:executionRoleArn:StartBulkDeployment' :: Text
executionRoleArn = Text
pExecutionRoleArn_,
        $sel:inputFileUri:StartBulkDeployment' :: Text
inputFileUri = Text
pInputFileUri_
      }

-- | A client token used to correlate requests and responses.
startBulkDeployment_amznClientToken :: Lens.Lens' StartBulkDeployment (Prelude.Maybe Prelude.Text)
startBulkDeployment_amznClientToken :: Lens' StartBulkDeployment (Maybe Text)
startBulkDeployment_amznClientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBulkDeployment' {Maybe Text
amznClientToken :: Maybe Text
$sel:amznClientToken:StartBulkDeployment' :: StartBulkDeployment -> Maybe Text
amznClientToken} -> Maybe Text
amznClientToken) (\s :: StartBulkDeployment
s@StartBulkDeployment' {} Maybe Text
a -> StartBulkDeployment
s {$sel:amznClientToken:StartBulkDeployment' :: Maybe Text
amznClientToken = Maybe Text
a} :: StartBulkDeployment)

-- | Tag(s) to add to the new resource.
startBulkDeployment_tags :: Lens.Lens' StartBulkDeployment (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startBulkDeployment_tags :: Lens' StartBulkDeployment (Maybe (HashMap Text Text))
startBulkDeployment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBulkDeployment' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:StartBulkDeployment' :: StartBulkDeployment -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: StartBulkDeployment
s@StartBulkDeployment' {} Maybe (HashMap Text Text)
a -> StartBulkDeployment
s {$sel:tags:StartBulkDeployment' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: StartBulkDeployment) 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 ARN of the execution role to associate with the bulk deployment
-- operation. This IAM role must allow the
-- \'\'greengrass:CreateDeployment\'\' action for all group versions that
-- are listed in the input file. This IAM role must have access to the S3
-- bucket containing the input file.
startBulkDeployment_executionRoleArn :: Lens.Lens' StartBulkDeployment Prelude.Text
startBulkDeployment_executionRoleArn :: Lens' StartBulkDeployment Text
startBulkDeployment_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBulkDeployment' {Text
executionRoleArn :: Text
$sel:executionRoleArn:StartBulkDeployment' :: StartBulkDeployment -> Text
executionRoleArn} -> Text
executionRoleArn) (\s :: StartBulkDeployment
s@StartBulkDeployment' {} Text
a -> StartBulkDeployment
s {$sel:executionRoleArn:StartBulkDeployment' :: Text
executionRoleArn = Text
a} :: StartBulkDeployment)

-- | The URI of the input file contained in the S3 bucket. The execution role
-- must have \'\'getObject\'\' permissions on this bucket to access the
-- input file. The input file is a JSON-serialized, line delimited file
-- with UTF-8 encoding that provides a list of group and version IDs and
-- the deployment type. This file must be less than 100 MB. Currently, AWS
-- IoT Greengrass supports only \'\'NewDeployment\'\' deployment types.
startBulkDeployment_inputFileUri :: Lens.Lens' StartBulkDeployment Prelude.Text
startBulkDeployment_inputFileUri :: Lens' StartBulkDeployment Text
startBulkDeployment_inputFileUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBulkDeployment' {Text
inputFileUri :: Text
$sel:inputFileUri:StartBulkDeployment' :: StartBulkDeployment -> Text
inputFileUri} -> Text
inputFileUri) (\s :: StartBulkDeployment
s@StartBulkDeployment' {} Text
a -> StartBulkDeployment
s {$sel:inputFileUri:StartBulkDeployment' :: Text
inputFileUri = Text
a} :: StartBulkDeployment)

instance Core.AWSRequest StartBulkDeployment where
  type
    AWSResponse StartBulkDeployment =
      StartBulkDeploymentResponse
  request :: (Service -> Service)
-> StartBulkDeployment -> Request StartBulkDeployment
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 StartBulkDeployment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartBulkDeployment)))
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 -> StartBulkDeploymentResponse
StartBulkDeploymentResponse'
            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
"BulkDeploymentArn")
            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
"BulkDeploymentId")
            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 StartBulkDeployment where
  hashWithSalt :: Int -> StartBulkDeployment -> Int
hashWithSalt Int
_salt StartBulkDeployment' {Maybe Text
Maybe (HashMap Text Text)
Text
inputFileUri :: Text
executionRoleArn :: Text
tags :: Maybe (HashMap Text Text)
amznClientToken :: Maybe Text
$sel:inputFileUri:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:executionRoleArn:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:tags:StartBulkDeployment' :: StartBulkDeployment -> Maybe (HashMap Text Text)
$sel:amznClientToken:StartBulkDeployment' :: StartBulkDeployment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
amznClientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputFileUri

instance Prelude.NFData StartBulkDeployment where
  rnf :: StartBulkDeployment -> ()
rnf StartBulkDeployment' {Maybe Text
Maybe (HashMap Text Text)
Text
inputFileUri :: Text
executionRoleArn :: Text
tags :: Maybe (HashMap Text Text)
amznClientToken :: Maybe Text
$sel:inputFileUri:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:executionRoleArn:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:tags:StartBulkDeployment' :: StartBulkDeployment -> Maybe (HashMap Text Text)
$sel:amznClientToken:StartBulkDeployment' :: StartBulkDeployment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
amznClientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
inputFileUri

instance Data.ToHeaders StartBulkDeployment where
  toHeaders :: StartBulkDeployment -> ResponseHeaders
toHeaders StartBulkDeployment' {Maybe Text
Maybe (HashMap Text Text)
Text
inputFileUri :: Text
executionRoleArn :: Text
tags :: Maybe (HashMap Text Text)
amznClientToken :: Maybe Text
$sel:inputFileUri:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:executionRoleArn:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:tags:StartBulkDeployment' :: StartBulkDeployment -> Maybe (HashMap Text Text)
$sel:amznClientToken:StartBulkDeployment' :: StartBulkDeployment -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amzn-Client-Token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
amznClientToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON StartBulkDeployment where
  toJSON :: StartBulkDeployment -> Value
toJSON StartBulkDeployment' {Maybe Text
Maybe (HashMap Text Text)
Text
inputFileUri :: Text
executionRoleArn :: Text
tags :: Maybe (HashMap Text Text)
amznClientToken :: Maybe Text
$sel:inputFileUri:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:executionRoleArn:StartBulkDeployment' :: StartBulkDeployment -> Text
$sel:tags:StartBulkDeployment' :: StartBulkDeployment -> Maybe (HashMap Text Text)
$sel:amznClientToken:StartBulkDeployment' :: StartBulkDeployment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ExecutionRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
executionRoleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"InputFileUri" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
inputFileUri)
          ]
      )

instance Data.ToPath StartBulkDeployment where
  toPath :: StartBulkDeployment -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/greengrass/bulk/deployments"

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

-- | /See:/ 'newStartBulkDeploymentResponse' smart constructor.
data StartBulkDeploymentResponse = StartBulkDeploymentResponse'
  { -- | The ARN of the bulk deployment.
    StartBulkDeploymentResponse -> Maybe Text
bulkDeploymentArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the bulk deployment.
    StartBulkDeploymentResponse -> Maybe Text
bulkDeploymentId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartBulkDeploymentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartBulkDeploymentResponse -> StartBulkDeploymentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBulkDeploymentResponse -> StartBulkDeploymentResponse -> Bool
$c/= :: StartBulkDeploymentResponse -> StartBulkDeploymentResponse -> Bool
== :: StartBulkDeploymentResponse -> StartBulkDeploymentResponse -> Bool
$c== :: StartBulkDeploymentResponse -> StartBulkDeploymentResponse -> Bool
Prelude.Eq, ReadPrec [StartBulkDeploymentResponse]
ReadPrec StartBulkDeploymentResponse
Int -> ReadS StartBulkDeploymentResponse
ReadS [StartBulkDeploymentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartBulkDeploymentResponse]
$creadListPrec :: ReadPrec [StartBulkDeploymentResponse]
readPrec :: ReadPrec StartBulkDeploymentResponse
$creadPrec :: ReadPrec StartBulkDeploymentResponse
readList :: ReadS [StartBulkDeploymentResponse]
$creadList :: ReadS [StartBulkDeploymentResponse]
readsPrec :: Int -> ReadS StartBulkDeploymentResponse
$creadsPrec :: Int -> ReadS StartBulkDeploymentResponse
Prelude.Read, Int -> StartBulkDeploymentResponse -> ShowS
[StartBulkDeploymentResponse] -> ShowS
StartBulkDeploymentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBulkDeploymentResponse] -> ShowS
$cshowList :: [StartBulkDeploymentResponse] -> ShowS
show :: StartBulkDeploymentResponse -> String
$cshow :: StartBulkDeploymentResponse -> String
showsPrec :: Int -> StartBulkDeploymentResponse -> ShowS
$cshowsPrec :: Int -> StartBulkDeploymentResponse -> ShowS
Prelude.Show, forall x.
Rep StartBulkDeploymentResponse x -> StartBulkDeploymentResponse
forall x.
StartBulkDeploymentResponse -> Rep StartBulkDeploymentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartBulkDeploymentResponse x -> StartBulkDeploymentResponse
$cfrom :: forall x.
StartBulkDeploymentResponse -> Rep StartBulkDeploymentResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartBulkDeploymentResponse' 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:
--
-- 'bulkDeploymentArn', 'startBulkDeploymentResponse_bulkDeploymentArn' - The ARN of the bulk deployment.
--
-- 'bulkDeploymentId', 'startBulkDeploymentResponse_bulkDeploymentId' - The ID of the bulk deployment.
--
-- 'httpStatus', 'startBulkDeploymentResponse_httpStatus' - The response's http status code.
newStartBulkDeploymentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartBulkDeploymentResponse
newStartBulkDeploymentResponse :: Int -> StartBulkDeploymentResponse
newStartBulkDeploymentResponse Int
pHttpStatus_ =
  StartBulkDeploymentResponse'
    { $sel:bulkDeploymentArn:StartBulkDeploymentResponse' :: Maybe Text
bulkDeploymentArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:bulkDeploymentId:StartBulkDeploymentResponse' :: Maybe Text
bulkDeploymentId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartBulkDeploymentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the bulk deployment.
startBulkDeploymentResponse_bulkDeploymentArn :: Lens.Lens' StartBulkDeploymentResponse (Prelude.Maybe Prelude.Text)
startBulkDeploymentResponse_bulkDeploymentArn :: Lens' StartBulkDeploymentResponse (Maybe Text)
startBulkDeploymentResponse_bulkDeploymentArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBulkDeploymentResponse' {Maybe Text
bulkDeploymentArn :: Maybe Text
$sel:bulkDeploymentArn:StartBulkDeploymentResponse' :: StartBulkDeploymentResponse -> Maybe Text
bulkDeploymentArn} -> Maybe Text
bulkDeploymentArn) (\s :: StartBulkDeploymentResponse
s@StartBulkDeploymentResponse' {} Maybe Text
a -> StartBulkDeploymentResponse
s {$sel:bulkDeploymentArn:StartBulkDeploymentResponse' :: Maybe Text
bulkDeploymentArn = Maybe Text
a} :: StartBulkDeploymentResponse)

-- | The ID of the bulk deployment.
startBulkDeploymentResponse_bulkDeploymentId :: Lens.Lens' StartBulkDeploymentResponse (Prelude.Maybe Prelude.Text)
startBulkDeploymentResponse_bulkDeploymentId :: Lens' StartBulkDeploymentResponse (Maybe Text)
startBulkDeploymentResponse_bulkDeploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBulkDeploymentResponse' {Maybe Text
bulkDeploymentId :: Maybe Text
$sel:bulkDeploymentId:StartBulkDeploymentResponse' :: StartBulkDeploymentResponse -> Maybe Text
bulkDeploymentId} -> Maybe Text
bulkDeploymentId) (\s :: StartBulkDeploymentResponse
s@StartBulkDeploymentResponse' {} Maybe Text
a -> StartBulkDeploymentResponse
s {$sel:bulkDeploymentId:StartBulkDeploymentResponse' :: Maybe Text
bulkDeploymentId = Maybe Text
a} :: StartBulkDeploymentResponse)

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

instance Prelude.NFData StartBulkDeploymentResponse where
  rnf :: StartBulkDeploymentResponse -> ()
rnf StartBulkDeploymentResponse' {Int
Maybe Text
httpStatus :: Int
bulkDeploymentId :: Maybe Text
bulkDeploymentArn :: Maybe Text
$sel:httpStatus:StartBulkDeploymentResponse' :: StartBulkDeploymentResponse -> Int
$sel:bulkDeploymentId:StartBulkDeploymentResponse' :: StartBulkDeploymentResponse -> Maybe Text
$sel:bulkDeploymentArn:StartBulkDeploymentResponse' :: StartBulkDeploymentResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bulkDeploymentArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bulkDeploymentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus