{-# 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.GreengrassV2.CreateDeployment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a continuous deployment for a target, which is a Greengrass core
-- device or group of core devices. When you add a new core device to a
-- group of core devices that has a deployment, IoT Greengrass deploys that
-- group\'s deployment to the new device.
--
-- You can define one deployment for each target. When you create a new
-- deployment for a target that has an existing deployment, you replace the
-- previous deployment. IoT Greengrass applies the new deployment to the
-- target devices.
--
-- Every deployment has a revision number that indicates how many
-- deployment revisions you define for a target. Use this operation to
-- create a new revision of an existing deployment.
--
-- For more information, see the
-- <https://docs.aws.amazon.com/greengrass/v2/developerguide/create-deployments.html Create deployments>
-- in the /IoT Greengrass V2 Developer Guide/.
module Amazonka.GreengrassV2.CreateDeployment
  ( -- * Creating a Request
    CreateDeployment (..),
    newCreateDeployment,

    -- * Request Lenses
    createDeployment_clientToken,
    createDeployment_components,
    createDeployment_deploymentName,
    createDeployment_deploymentPolicies,
    createDeployment_iotJobConfiguration,
    createDeployment_parentTargetArn,
    createDeployment_tags,
    createDeployment_targetArn,

    -- * Destructuring the Response
    CreateDeploymentResponse (..),
    newCreateDeploymentResponse,

    -- * Response Lenses
    createDeploymentResponse_deploymentId,
    createDeploymentResponse_iotJobArn,
    createDeploymentResponse_iotJobId,
    createDeploymentResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateDeployment' smart constructor.
data CreateDeployment = CreateDeployment'
  { -- | A unique, case-sensitive identifier that you can provide to ensure that
    -- the request is idempotent. Idempotency means that the request is
    -- successfully processed only once, even if you send the request multiple
    -- times. When a request succeeds, and you specify the same client token
    -- for subsequent successful requests, the IoT Greengrass V2 service
    -- returns the successful response that it caches from the previous
    -- request. IoT Greengrass V2 caches successful responses for idempotent
    -- requests for up to 8 hours.
    CreateDeployment -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The components to deploy. This is a dictionary, where each key is the
    -- name of a component, and each key\'s value is the version and
    -- configuration to deploy for that component.
    CreateDeployment
-> Maybe (HashMap Text ComponentDeploymentSpecification)
components :: Prelude.Maybe (Prelude.HashMap Prelude.Text ComponentDeploymentSpecification),
    -- | The name of the deployment.
    CreateDeployment -> Maybe Text
deploymentName :: Prelude.Maybe Prelude.Text,
    -- | The deployment policies for the deployment. These policies define how
    -- the deployment updates components and handles failure.
    CreateDeployment -> Maybe DeploymentPolicies
deploymentPolicies :: Prelude.Maybe DeploymentPolicies,
    -- | The job configuration for the deployment configuration. The job
    -- configuration specifies the rollout, timeout, and stop configurations
    -- for the deployment configuration.
    CreateDeployment -> Maybe DeploymentIoTJobConfiguration
iotJobConfiguration :: Prelude.Maybe DeploymentIoTJobConfiguration,
    -- | The parent deployment\'s target
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- within a subdeployment.
    CreateDeployment -> Maybe Text
parentTargetArn :: Prelude.Maybe Prelude.Text,
    -- | A list of key-value pairs that contain metadata for the resource. For
    -- more information, see
    -- <https://docs.aws.amazon.com/greengrass/v2/developerguide/tag-resources.html Tag your resources>
    -- in the /IoT Greengrass V2 Developer Guide/.
    CreateDeployment -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the target IoT thing or thing group. When creating a subdeployment,
    -- the targetARN can only be a thing group.
    CreateDeployment -> Text
targetArn :: Prelude.Text
  }
  deriving (CreateDeployment -> CreateDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeployment -> CreateDeployment -> Bool
$c/= :: CreateDeployment -> CreateDeployment -> Bool
== :: CreateDeployment -> CreateDeployment -> Bool
$c== :: CreateDeployment -> CreateDeployment -> Bool
Prelude.Eq, ReadPrec [CreateDeployment]
ReadPrec CreateDeployment
Int -> ReadS CreateDeployment
ReadS [CreateDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeployment]
$creadListPrec :: ReadPrec [CreateDeployment]
readPrec :: ReadPrec CreateDeployment
$creadPrec :: ReadPrec CreateDeployment
readList :: ReadS [CreateDeployment]
$creadList :: ReadS [CreateDeployment]
readsPrec :: Int -> ReadS CreateDeployment
$creadsPrec :: Int -> ReadS CreateDeployment
Prelude.Read, Int -> CreateDeployment -> ShowS
[CreateDeployment] -> ShowS
CreateDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeployment] -> ShowS
$cshowList :: [CreateDeployment] -> ShowS
show :: CreateDeployment -> String
$cshow :: CreateDeployment -> String
showsPrec :: Int -> CreateDeployment -> ShowS
$cshowsPrec :: Int -> CreateDeployment -> ShowS
Prelude.Show, forall x. Rep CreateDeployment x -> CreateDeployment
forall x. CreateDeployment -> Rep CreateDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDeployment x -> CreateDeployment
$cfrom :: forall x. CreateDeployment -> Rep CreateDeployment x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeployment' 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:
--
-- 'clientToken', 'createDeployment_clientToken' - A unique, case-sensitive identifier that you can provide to ensure that
-- the request is idempotent. Idempotency means that the request is
-- successfully processed only once, even if you send the request multiple
-- times. When a request succeeds, and you specify the same client token
-- for subsequent successful requests, the IoT Greengrass V2 service
-- returns the successful response that it caches from the previous
-- request. IoT Greengrass V2 caches successful responses for idempotent
-- requests for up to 8 hours.
--
-- 'components', 'createDeployment_components' - The components to deploy. This is a dictionary, where each key is the
-- name of a component, and each key\'s value is the version and
-- configuration to deploy for that component.
--
-- 'deploymentName', 'createDeployment_deploymentName' - The name of the deployment.
--
-- 'deploymentPolicies', 'createDeployment_deploymentPolicies' - The deployment policies for the deployment. These policies define how
-- the deployment updates components and handles failure.
--
-- 'iotJobConfiguration', 'createDeployment_iotJobConfiguration' - The job configuration for the deployment configuration. The job
-- configuration specifies the rollout, timeout, and stop configurations
-- for the deployment configuration.
--
-- 'parentTargetArn', 'createDeployment_parentTargetArn' - The parent deployment\'s target
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- within a subdeployment.
--
-- 'tags', 'createDeployment_tags' - A list of key-value pairs that contain metadata for the resource. For
-- more information, see
-- <https://docs.aws.amazon.com/greengrass/v2/developerguide/tag-resources.html Tag your resources>
-- in the /IoT Greengrass V2 Developer Guide/.
--
-- 'targetArn', 'createDeployment_targetArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the target IoT thing or thing group. When creating a subdeployment,
-- the targetARN can only be a thing group.
newCreateDeployment ::
  -- | 'targetArn'
  Prelude.Text ->
  CreateDeployment
newCreateDeployment :: Text -> CreateDeployment
newCreateDeployment Text
pTargetArn_ =
  CreateDeployment'
    { $sel:clientToken:CreateDeployment' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:components:CreateDeployment' :: Maybe (HashMap Text ComponentDeploymentSpecification)
components = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentName:CreateDeployment' :: Maybe Text
deploymentName = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentPolicies:CreateDeployment' :: Maybe DeploymentPolicies
deploymentPolicies = forall a. Maybe a
Prelude.Nothing,
      $sel:iotJobConfiguration:CreateDeployment' :: Maybe DeploymentIoTJobConfiguration
iotJobConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:parentTargetArn:CreateDeployment' :: Maybe Text
parentTargetArn = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDeployment' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:targetArn:CreateDeployment' :: Text
targetArn = Text
pTargetArn_
    }

-- | A unique, case-sensitive identifier that you can provide to ensure that
-- the request is idempotent. Idempotency means that the request is
-- successfully processed only once, even if you send the request multiple
-- times. When a request succeeds, and you specify the same client token
-- for subsequent successful requests, the IoT Greengrass V2 service
-- returns the successful response that it caches from the previous
-- request. IoT Greengrass V2 caches successful responses for idempotent
-- requests for up to 8 hours.
createDeployment_clientToken :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_clientToken :: Lens' CreateDeployment (Maybe Text)
createDeployment_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:clientToken:CreateDeployment' :: Maybe Text
clientToken = Maybe Text
a} :: CreateDeployment)

-- | The components to deploy. This is a dictionary, where each key is the
-- name of a component, and each key\'s value is the version and
-- configuration to deploy for that component.
createDeployment_components :: Lens.Lens' CreateDeployment (Prelude.Maybe (Prelude.HashMap Prelude.Text ComponentDeploymentSpecification))
createDeployment_components :: Lens'
  CreateDeployment
  (Maybe (HashMap Text ComponentDeploymentSpecification))
createDeployment_components = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe (HashMap Text ComponentDeploymentSpecification)
components :: Maybe (HashMap Text ComponentDeploymentSpecification)
$sel:components:CreateDeployment' :: CreateDeployment
-> Maybe (HashMap Text ComponentDeploymentSpecification)
components} -> Maybe (HashMap Text ComponentDeploymentSpecification)
components) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe (HashMap Text ComponentDeploymentSpecification)
a -> CreateDeployment
s {$sel:components:CreateDeployment' :: Maybe (HashMap Text ComponentDeploymentSpecification)
components = Maybe (HashMap Text ComponentDeploymentSpecification)
a} :: CreateDeployment) 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 name of the deployment.
createDeployment_deploymentName :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_deploymentName :: Lens' CreateDeployment (Maybe Text)
createDeployment_deploymentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
deploymentName :: Maybe Text
$sel:deploymentName:CreateDeployment' :: CreateDeployment -> Maybe Text
deploymentName} -> Maybe Text
deploymentName) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:deploymentName:CreateDeployment' :: Maybe Text
deploymentName = Maybe Text
a} :: CreateDeployment)

-- | The deployment policies for the deployment. These policies define how
-- the deployment updates components and handles failure.
createDeployment_deploymentPolicies :: Lens.Lens' CreateDeployment (Prelude.Maybe DeploymentPolicies)
createDeployment_deploymentPolicies :: Lens' CreateDeployment (Maybe DeploymentPolicies)
createDeployment_deploymentPolicies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe DeploymentPolicies
deploymentPolicies :: Maybe DeploymentPolicies
$sel:deploymentPolicies:CreateDeployment' :: CreateDeployment -> Maybe DeploymentPolicies
deploymentPolicies} -> Maybe DeploymentPolicies
deploymentPolicies) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe DeploymentPolicies
a -> CreateDeployment
s {$sel:deploymentPolicies:CreateDeployment' :: Maybe DeploymentPolicies
deploymentPolicies = Maybe DeploymentPolicies
a} :: CreateDeployment)

-- | The job configuration for the deployment configuration. The job
-- configuration specifies the rollout, timeout, and stop configurations
-- for the deployment configuration.
createDeployment_iotJobConfiguration :: Lens.Lens' CreateDeployment (Prelude.Maybe DeploymentIoTJobConfiguration)
createDeployment_iotJobConfiguration :: Lens' CreateDeployment (Maybe DeploymentIoTJobConfiguration)
createDeployment_iotJobConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe DeploymentIoTJobConfiguration
iotJobConfiguration :: Maybe DeploymentIoTJobConfiguration
$sel:iotJobConfiguration:CreateDeployment' :: CreateDeployment -> Maybe DeploymentIoTJobConfiguration
iotJobConfiguration} -> Maybe DeploymentIoTJobConfiguration
iotJobConfiguration) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe DeploymentIoTJobConfiguration
a -> CreateDeployment
s {$sel:iotJobConfiguration:CreateDeployment' :: Maybe DeploymentIoTJobConfiguration
iotJobConfiguration = Maybe DeploymentIoTJobConfiguration
a} :: CreateDeployment)

-- | The parent deployment\'s target
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- within a subdeployment.
createDeployment_parentTargetArn :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_parentTargetArn :: Lens' CreateDeployment (Maybe Text)
createDeployment_parentTargetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
parentTargetArn :: Maybe Text
$sel:parentTargetArn:CreateDeployment' :: CreateDeployment -> Maybe Text
parentTargetArn} -> Maybe Text
parentTargetArn) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:parentTargetArn:CreateDeployment' :: Maybe Text
parentTargetArn = Maybe Text
a} :: CreateDeployment)

-- | A list of key-value pairs that contain metadata for the resource. For
-- more information, see
-- <https://docs.aws.amazon.com/greengrass/v2/developerguide/tag-resources.html Tag your resources>
-- in the /IoT Greengrass V2 Developer Guide/.
createDeployment_tags :: Lens.Lens' CreateDeployment (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createDeployment_tags :: Lens' CreateDeployment (Maybe (HashMap Text Text))
createDeployment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateDeployment' :: CreateDeployment -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe (HashMap Text Text)
a -> CreateDeployment
s {$sel:tags:CreateDeployment' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateDeployment) 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
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the target IoT thing or thing group. When creating a subdeployment,
-- the targetARN can only be a thing group.
createDeployment_targetArn :: Lens.Lens' CreateDeployment Prelude.Text
createDeployment_targetArn :: Lens' CreateDeployment Text
createDeployment_targetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Text
targetArn :: Text
$sel:targetArn:CreateDeployment' :: CreateDeployment -> Text
targetArn} -> Text
targetArn) (\s :: CreateDeployment
s@CreateDeployment' {} Text
a -> CreateDeployment
s {$sel:targetArn:CreateDeployment' :: Text
targetArn = Text
a} :: CreateDeployment)

instance Core.AWSRequest CreateDeployment where
  type
    AWSResponse CreateDeployment =
      CreateDeploymentResponse
  request :: (Service -> Service)
-> CreateDeployment -> Request CreateDeployment
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 CreateDeployment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDeployment)))
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 -> Maybe Text -> Int -> CreateDeploymentResponse
CreateDeploymentResponse'
            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
"deploymentId")
            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
"iotJobArn")
            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
"iotJobId")
            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 CreateDeployment where
  hashWithSalt :: Int -> CreateDeployment -> Int
hashWithSalt Int
_salt CreateDeployment' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ComponentDeploymentSpecification)
Maybe DeploymentPolicies
Maybe DeploymentIoTJobConfiguration
Text
targetArn :: Text
tags :: Maybe (HashMap Text Text)
parentTargetArn :: Maybe Text
iotJobConfiguration :: Maybe DeploymentIoTJobConfiguration
deploymentPolicies :: Maybe DeploymentPolicies
deploymentName :: Maybe Text
components :: Maybe (HashMap Text ComponentDeploymentSpecification)
clientToken :: Maybe Text
$sel:targetArn:CreateDeployment' :: CreateDeployment -> Text
$sel:tags:CreateDeployment' :: CreateDeployment -> Maybe (HashMap Text Text)
$sel:parentTargetArn:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:iotJobConfiguration:CreateDeployment' :: CreateDeployment -> Maybe DeploymentIoTJobConfiguration
$sel:deploymentPolicies:CreateDeployment' :: CreateDeployment -> Maybe DeploymentPolicies
$sel:deploymentName:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:components:CreateDeployment' :: CreateDeployment
-> Maybe (HashMap Text ComponentDeploymentSpecification)
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text ComponentDeploymentSpecification)
components
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deploymentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeploymentPolicies
deploymentPolicies
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeploymentIoTJobConfiguration
iotJobConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parentTargetArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetArn

instance Prelude.NFData CreateDeployment where
  rnf :: CreateDeployment -> ()
rnf CreateDeployment' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ComponentDeploymentSpecification)
Maybe DeploymentPolicies
Maybe DeploymentIoTJobConfiguration
Text
targetArn :: Text
tags :: Maybe (HashMap Text Text)
parentTargetArn :: Maybe Text
iotJobConfiguration :: Maybe DeploymentIoTJobConfiguration
deploymentPolicies :: Maybe DeploymentPolicies
deploymentName :: Maybe Text
components :: Maybe (HashMap Text ComponentDeploymentSpecification)
clientToken :: Maybe Text
$sel:targetArn:CreateDeployment' :: CreateDeployment -> Text
$sel:tags:CreateDeployment' :: CreateDeployment -> Maybe (HashMap Text Text)
$sel:parentTargetArn:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:iotJobConfiguration:CreateDeployment' :: CreateDeployment -> Maybe DeploymentIoTJobConfiguration
$sel:deploymentPolicies:CreateDeployment' :: CreateDeployment -> Maybe DeploymentPolicies
$sel:deploymentName:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:components:CreateDeployment' :: CreateDeployment
-> Maybe (HashMap Text ComponentDeploymentSpecification)
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text ComponentDeploymentSpecification)
components
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deploymentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentPolicies
deploymentPolicies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentIoTJobConfiguration
iotJobConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentTargetArn
      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
targetArn

instance Data.ToHeaders CreateDeployment where
  toHeaders :: CreateDeployment -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON CreateDeployment where
  toJSON :: CreateDeployment -> Value
toJSON CreateDeployment' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ComponentDeploymentSpecification)
Maybe DeploymentPolicies
Maybe DeploymentIoTJobConfiguration
Text
targetArn :: Text
tags :: Maybe (HashMap Text Text)
parentTargetArn :: Maybe Text
iotJobConfiguration :: Maybe DeploymentIoTJobConfiguration
deploymentPolicies :: Maybe DeploymentPolicies
deploymentName :: Maybe Text
components :: Maybe (HashMap Text ComponentDeploymentSpecification)
clientToken :: Maybe Text
$sel:targetArn:CreateDeployment' :: CreateDeployment -> Text
$sel:tags:CreateDeployment' :: CreateDeployment -> Maybe (HashMap Text Text)
$sel:parentTargetArn:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:iotJobConfiguration:CreateDeployment' :: CreateDeployment -> Maybe DeploymentIoTJobConfiguration
$sel:deploymentPolicies:CreateDeployment' :: CreateDeployment -> Maybe DeploymentPolicies
$sel:deploymentName:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:components:CreateDeployment' :: CreateDeployment
-> Maybe (HashMap Text ComponentDeploymentSpecification)
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"components" 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 ComponentDeploymentSpecification)
components,
            (Key
"deploymentName" 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
deploymentName,
            (Key
"deploymentPolicies" 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 DeploymentPolicies
deploymentPolicies,
            (Key
"iotJobConfiguration" 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 DeploymentIoTJobConfiguration
iotJobConfiguration,
            (Key
"parentTargetArn" 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
parentTargetArn,
            (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
"targetArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
targetArn)
          ]
      )

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

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

-- | /See:/ 'newCreateDeploymentResponse' smart constructor.
data CreateDeploymentResponse = CreateDeploymentResponse'
  { -- | The ID of the deployment.
    CreateDeploymentResponse -> Maybe Text
deploymentId :: Prelude.Maybe Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the IoT job that applies the deployment to target devices.
    CreateDeploymentResponse -> Maybe Text
iotJobArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the IoT job that applies the deployment to target devices.
    CreateDeploymentResponse -> Maybe Text
iotJobId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDeploymentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDeploymentResponse -> CreateDeploymentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeploymentResponse -> CreateDeploymentResponse -> Bool
$c/= :: CreateDeploymentResponse -> CreateDeploymentResponse -> Bool
== :: CreateDeploymentResponse -> CreateDeploymentResponse -> Bool
$c== :: CreateDeploymentResponse -> CreateDeploymentResponse -> Bool
Prelude.Eq, ReadPrec [CreateDeploymentResponse]
ReadPrec CreateDeploymentResponse
Int -> ReadS CreateDeploymentResponse
ReadS [CreateDeploymentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeploymentResponse]
$creadListPrec :: ReadPrec [CreateDeploymentResponse]
readPrec :: ReadPrec CreateDeploymentResponse
$creadPrec :: ReadPrec CreateDeploymentResponse
readList :: ReadS [CreateDeploymentResponse]
$creadList :: ReadS [CreateDeploymentResponse]
readsPrec :: Int -> ReadS CreateDeploymentResponse
$creadsPrec :: Int -> ReadS CreateDeploymentResponse
Prelude.Read, Int -> CreateDeploymentResponse -> ShowS
[CreateDeploymentResponse] -> ShowS
CreateDeploymentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeploymentResponse] -> ShowS
$cshowList :: [CreateDeploymentResponse] -> ShowS
show :: CreateDeploymentResponse -> String
$cshow :: CreateDeploymentResponse -> String
showsPrec :: Int -> CreateDeploymentResponse -> ShowS
$cshowsPrec :: Int -> CreateDeploymentResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDeploymentResponse x -> CreateDeploymentResponse
forall x.
CreateDeploymentResponse -> Rep CreateDeploymentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDeploymentResponse x -> CreateDeploymentResponse
$cfrom :: forall x.
CreateDeploymentResponse -> Rep CreateDeploymentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeploymentResponse' 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', 'createDeploymentResponse_deploymentId' - The ID of the deployment.
--
-- 'iotJobArn', 'createDeploymentResponse_iotJobArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the IoT job that applies the deployment to target devices.
--
-- 'iotJobId', 'createDeploymentResponse_iotJobId' - The ID of the IoT job that applies the deployment to target devices.
--
-- 'httpStatus', 'createDeploymentResponse_httpStatus' - The response's http status code.
newCreateDeploymentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDeploymentResponse
newCreateDeploymentResponse :: Int -> CreateDeploymentResponse
newCreateDeploymentResponse Int
pHttpStatus_ =
  CreateDeploymentResponse'
    { $sel:deploymentId:CreateDeploymentResponse' :: Maybe Text
deploymentId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:iotJobArn:CreateDeploymentResponse' :: Maybe Text
iotJobArn = forall a. Maybe a
Prelude.Nothing,
      $sel:iotJobId:CreateDeploymentResponse' :: Maybe Text
iotJobId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDeploymentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the IoT job that applies the deployment to target devices.
createDeploymentResponse_iotJobArn :: Lens.Lens' CreateDeploymentResponse (Prelude.Maybe Prelude.Text)
createDeploymentResponse_iotJobArn :: Lens' CreateDeploymentResponse (Maybe Text)
createDeploymentResponse_iotJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentResponse' {Maybe Text
iotJobArn :: Maybe Text
$sel:iotJobArn:CreateDeploymentResponse' :: CreateDeploymentResponse -> Maybe Text
iotJobArn} -> Maybe Text
iotJobArn) (\s :: CreateDeploymentResponse
s@CreateDeploymentResponse' {} Maybe Text
a -> CreateDeploymentResponse
s {$sel:iotJobArn:CreateDeploymentResponse' :: Maybe Text
iotJobArn = Maybe Text
a} :: CreateDeploymentResponse)

-- | The ID of the IoT job that applies the deployment to target devices.
createDeploymentResponse_iotJobId :: Lens.Lens' CreateDeploymentResponse (Prelude.Maybe Prelude.Text)
createDeploymentResponse_iotJobId :: Lens' CreateDeploymentResponse (Maybe Text)
createDeploymentResponse_iotJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentResponse' {Maybe Text
iotJobId :: Maybe Text
$sel:iotJobId:CreateDeploymentResponse' :: CreateDeploymentResponse -> Maybe Text
iotJobId} -> Maybe Text
iotJobId) (\s :: CreateDeploymentResponse
s@CreateDeploymentResponse' {} Maybe Text
a -> CreateDeploymentResponse
s {$sel:iotJobId:CreateDeploymentResponse' :: Maybe Text
iotJobId = Maybe Text
a} :: CreateDeploymentResponse)

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

instance Prelude.NFData CreateDeploymentResponse where
  rnf :: CreateDeploymentResponse -> ()
rnf CreateDeploymentResponse' {Int
Maybe Text
httpStatus :: Int
iotJobId :: Maybe Text
iotJobArn :: Maybe Text
deploymentId :: Maybe Text
$sel:httpStatus:CreateDeploymentResponse' :: CreateDeploymentResponse -> Int
$sel:iotJobId:CreateDeploymentResponse' :: CreateDeploymentResponse -> Maybe Text
$sel:iotJobArn:CreateDeploymentResponse' :: CreateDeploymentResponse -> Maybe Text
$sel:deploymentId:CreateDeploymentResponse' :: CreateDeploymentResponse -> 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
iotJobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iotJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus