{-# 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.IoT.AssociateTargetsWithJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a group with a continuous job. The following criteria must be
-- met:
--
-- -   The job must have been created with the @targetSelection@ field set
--     to \"CONTINUOUS\".
--
-- -   The job status must currently be \"IN_PROGRESS\".
--
-- -   The total number of targets associated with a job must not exceed
--     100.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions AssociateTargetsWithJob>
-- action.
module Amazonka.IoT.AssociateTargetsWithJob
  ( -- * Creating a Request
    AssociateTargetsWithJob (..),
    newAssociateTargetsWithJob,

    -- * Request Lenses
    associateTargetsWithJob_comment,
    associateTargetsWithJob_namespaceId,
    associateTargetsWithJob_targets,
    associateTargetsWithJob_jobId,

    -- * Destructuring the Response
    AssociateTargetsWithJobResponse (..),
    newAssociateTargetsWithJobResponse,

    -- * Response Lenses
    associateTargetsWithJobResponse_description,
    associateTargetsWithJobResponse_jobArn,
    associateTargetsWithJobResponse_jobId,
    associateTargetsWithJobResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAssociateTargetsWithJob' smart constructor.
data AssociateTargetsWithJob = AssociateTargetsWithJob'
  { -- | An optional comment string describing why the job was associated with
    -- the targets.
    AssociateTargetsWithJob -> Maybe Text
comment :: Prelude.Maybe Prelude.Text,
    -- | The namespace used to indicate that a job is a customer-managed job.
    --
    -- When you specify a value for this parameter, Amazon Web Services IoT
    -- Core sends jobs notifications to MQTT topics that contain the value in
    -- the following format.
    --
    -- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
    --
    -- The @namespaceId@ feature is in public preview.
    AssociateTargetsWithJob -> Maybe Text
namespaceId :: Prelude.Maybe Prelude.Text,
    -- | A list of thing group ARNs that define the targets of the job.
    AssociateTargetsWithJob -> NonEmpty Text
targets :: Prelude.NonEmpty Prelude.Text,
    -- | The unique identifier you assigned to this job when it was created.
    AssociateTargetsWithJob -> Text
jobId :: Prelude.Text
  }
  deriving (AssociateTargetsWithJob -> AssociateTargetsWithJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateTargetsWithJob -> AssociateTargetsWithJob -> Bool
$c/= :: AssociateTargetsWithJob -> AssociateTargetsWithJob -> Bool
== :: AssociateTargetsWithJob -> AssociateTargetsWithJob -> Bool
$c== :: AssociateTargetsWithJob -> AssociateTargetsWithJob -> Bool
Prelude.Eq, ReadPrec [AssociateTargetsWithJob]
ReadPrec AssociateTargetsWithJob
Int -> ReadS AssociateTargetsWithJob
ReadS [AssociateTargetsWithJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateTargetsWithJob]
$creadListPrec :: ReadPrec [AssociateTargetsWithJob]
readPrec :: ReadPrec AssociateTargetsWithJob
$creadPrec :: ReadPrec AssociateTargetsWithJob
readList :: ReadS [AssociateTargetsWithJob]
$creadList :: ReadS [AssociateTargetsWithJob]
readsPrec :: Int -> ReadS AssociateTargetsWithJob
$creadsPrec :: Int -> ReadS AssociateTargetsWithJob
Prelude.Read, Int -> AssociateTargetsWithJob -> ShowS
[AssociateTargetsWithJob] -> ShowS
AssociateTargetsWithJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateTargetsWithJob] -> ShowS
$cshowList :: [AssociateTargetsWithJob] -> ShowS
show :: AssociateTargetsWithJob -> String
$cshow :: AssociateTargetsWithJob -> String
showsPrec :: Int -> AssociateTargetsWithJob -> ShowS
$cshowsPrec :: Int -> AssociateTargetsWithJob -> ShowS
Prelude.Show, forall x. Rep AssociateTargetsWithJob x -> AssociateTargetsWithJob
forall x. AssociateTargetsWithJob -> Rep AssociateTargetsWithJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateTargetsWithJob x -> AssociateTargetsWithJob
$cfrom :: forall x. AssociateTargetsWithJob -> Rep AssociateTargetsWithJob x
Prelude.Generic)

-- |
-- Create a value of 'AssociateTargetsWithJob' 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:
--
-- 'comment', 'associateTargetsWithJob_comment' - An optional comment string describing why the job was associated with
-- the targets.
--
-- 'namespaceId', 'associateTargetsWithJob_namespaceId' - The namespace used to indicate that a job is a customer-managed job.
--
-- When you specify a value for this parameter, Amazon Web Services IoT
-- Core sends jobs notifications to MQTT topics that contain the value in
-- the following format.
--
-- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
--
-- The @namespaceId@ feature is in public preview.
--
-- 'targets', 'associateTargetsWithJob_targets' - A list of thing group ARNs that define the targets of the job.
--
-- 'jobId', 'associateTargetsWithJob_jobId' - The unique identifier you assigned to this job when it was created.
newAssociateTargetsWithJob ::
  -- | 'targets'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'jobId'
  Prelude.Text ->
  AssociateTargetsWithJob
newAssociateTargetsWithJob :: NonEmpty Text -> Text -> AssociateTargetsWithJob
newAssociateTargetsWithJob NonEmpty Text
pTargets_ Text
pJobId_ =
  AssociateTargetsWithJob'
    { $sel:comment:AssociateTargetsWithJob' :: Maybe Text
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:namespaceId:AssociateTargetsWithJob' :: Maybe Text
namespaceId = forall a. Maybe a
Prelude.Nothing,
      $sel:targets:AssociateTargetsWithJob' :: NonEmpty Text
targets = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pTargets_,
      $sel:jobId:AssociateTargetsWithJob' :: Text
jobId = Text
pJobId_
    }

-- | An optional comment string describing why the job was associated with
-- the targets.
associateTargetsWithJob_comment :: Lens.Lens' AssociateTargetsWithJob (Prelude.Maybe Prelude.Text)
associateTargetsWithJob_comment :: Lens' AssociateTargetsWithJob (Maybe Text)
associateTargetsWithJob_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateTargetsWithJob' {Maybe Text
comment :: Maybe Text
$sel:comment:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
comment} -> Maybe Text
comment) (\s :: AssociateTargetsWithJob
s@AssociateTargetsWithJob' {} Maybe Text
a -> AssociateTargetsWithJob
s {$sel:comment:AssociateTargetsWithJob' :: Maybe Text
comment = Maybe Text
a} :: AssociateTargetsWithJob)

-- | The namespace used to indicate that a job is a customer-managed job.
--
-- When you specify a value for this parameter, Amazon Web Services IoT
-- Core sends jobs notifications to MQTT topics that contain the value in
-- the following format.
--
-- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
--
-- The @namespaceId@ feature is in public preview.
associateTargetsWithJob_namespaceId :: Lens.Lens' AssociateTargetsWithJob (Prelude.Maybe Prelude.Text)
associateTargetsWithJob_namespaceId :: Lens' AssociateTargetsWithJob (Maybe Text)
associateTargetsWithJob_namespaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateTargetsWithJob' {Maybe Text
namespaceId :: Maybe Text
$sel:namespaceId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
namespaceId} -> Maybe Text
namespaceId) (\s :: AssociateTargetsWithJob
s@AssociateTargetsWithJob' {} Maybe Text
a -> AssociateTargetsWithJob
s {$sel:namespaceId:AssociateTargetsWithJob' :: Maybe Text
namespaceId = Maybe Text
a} :: AssociateTargetsWithJob)

-- | A list of thing group ARNs that define the targets of the job.
associateTargetsWithJob_targets :: Lens.Lens' AssociateTargetsWithJob (Prelude.NonEmpty Prelude.Text)
associateTargetsWithJob_targets :: Lens' AssociateTargetsWithJob (NonEmpty Text)
associateTargetsWithJob_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateTargetsWithJob' {NonEmpty Text
targets :: NonEmpty Text
$sel:targets:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> NonEmpty Text
targets} -> NonEmpty Text
targets) (\s :: AssociateTargetsWithJob
s@AssociateTargetsWithJob' {} NonEmpty Text
a -> AssociateTargetsWithJob
s {$sel:targets:AssociateTargetsWithJob' :: NonEmpty Text
targets = NonEmpty Text
a} :: AssociateTargetsWithJob) 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

-- | The unique identifier you assigned to this job when it was created.
associateTargetsWithJob_jobId :: Lens.Lens' AssociateTargetsWithJob Prelude.Text
associateTargetsWithJob_jobId :: Lens' AssociateTargetsWithJob Text
associateTargetsWithJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateTargetsWithJob' {Text
jobId :: Text
$sel:jobId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Text
jobId} -> Text
jobId) (\s :: AssociateTargetsWithJob
s@AssociateTargetsWithJob' {} Text
a -> AssociateTargetsWithJob
s {$sel:jobId:AssociateTargetsWithJob' :: Text
jobId = Text
a} :: AssociateTargetsWithJob)

instance Core.AWSRequest AssociateTargetsWithJob where
  type
    AWSResponse AssociateTargetsWithJob =
      AssociateTargetsWithJobResponse
  request :: (Service -> Service)
-> AssociateTargetsWithJob -> Request AssociateTargetsWithJob
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 AssociateTargetsWithJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateTargetsWithJob)))
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
-> AssociateTargetsWithJobResponse
AssociateTargetsWithJobResponse'
            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
"description")
            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
"jobArn")
            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
"jobId")
            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 AssociateTargetsWithJob where
  hashWithSalt :: Int -> AssociateTargetsWithJob -> Int
hashWithSalt Int
_salt AssociateTargetsWithJob' {Maybe Text
NonEmpty Text
Text
jobId :: Text
targets :: NonEmpty Text
namespaceId :: Maybe Text
comment :: Maybe Text
$sel:jobId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Text
$sel:targets:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> NonEmpty Text
$sel:namespaceId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
$sel:comment:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
comment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
targets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData AssociateTargetsWithJob where
  rnf :: AssociateTargetsWithJob -> ()
rnf AssociateTargetsWithJob' {Maybe Text
NonEmpty Text
Text
jobId :: Text
targets :: NonEmpty Text
namespaceId :: Maybe Text
comment :: Maybe Text
$sel:jobId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Text
$sel:targets:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> NonEmpty Text
$sel:namespaceId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
$sel:comment:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
comment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
targets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

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

instance Data.ToJSON AssociateTargetsWithJob where
  toJSON :: AssociateTargetsWithJob -> Value
toJSON AssociateTargetsWithJob' {Maybe Text
NonEmpty Text
Text
jobId :: Text
targets :: NonEmpty Text
namespaceId :: Maybe Text
comment :: Maybe Text
$sel:jobId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Text
$sel:targets:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> NonEmpty Text
$sel:namespaceId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
$sel:comment:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"comment" 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
comment,
            forall a. a -> Maybe a
Prelude.Just (Key
"targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
targets)
          ]
      )

instance Data.ToPath AssociateTargetsWithJob where
  toPath :: AssociateTargetsWithJob -> ByteString
toPath AssociateTargetsWithJob' {Maybe Text
NonEmpty Text
Text
jobId :: Text
targets :: NonEmpty Text
namespaceId :: Maybe Text
comment :: Maybe Text
$sel:jobId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Text
$sel:targets:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> NonEmpty Text
$sel:namespaceId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
$sel:comment:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/jobs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId, ByteString
"/targets"]

instance Data.ToQuery AssociateTargetsWithJob where
  toQuery :: AssociateTargetsWithJob -> QueryString
toQuery AssociateTargetsWithJob' {Maybe Text
NonEmpty Text
Text
jobId :: Text
targets :: NonEmpty Text
namespaceId :: Maybe Text
comment :: Maybe Text
$sel:jobId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Text
$sel:targets:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> NonEmpty Text
$sel:namespaceId:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
$sel:comment:AssociateTargetsWithJob' :: AssociateTargetsWithJob -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"namespaceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namespaceId]

-- | /See:/ 'newAssociateTargetsWithJobResponse' smart constructor.
data AssociateTargetsWithJobResponse = AssociateTargetsWithJobResponse'
  { -- | A short text description of the job.
    AssociateTargetsWithJobResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An ARN identifying the job.
    AssociateTargetsWithJobResponse -> Maybe Text
jobArn :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier you assigned to this job when it was created.
    AssociateTargetsWithJobResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AssociateTargetsWithJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateTargetsWithJobResponse
-> AssociateTargetsWithJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateTargetsWithJobResponse
-> AssociateTargetsWithJobResponse -> Bool
$c/= :: AssociateTargetsWithJobResponse
-> AssociateTargetsWithJobResponse -> Bool
== :: AssociateTargetsWithJobResponse
-> AssociateTargetsWithJobResponse -> Bool
$c== :: AssociateTargetsWithJobResponse
-> AssociateTargetsWithJobResponse -> Bool
Prelude.Eq, ReadPrec [AssociateTargetsWithJobResponse]
ReadPrec AssociateTargetsWithJobResponse
Int -> ReadS AssociateTargetsWithJobResponse
ReadS [AssociateTargetsWithJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateTargetsWithJobResponse]
$creadListPrec :: ReadPrec [AssociateTargetsWithJobResponse]
readPrec :: ReadPrec AssociateTargetsWithJobResponse
$creadPrec :: ReadPrec AssociateTargetsWithJobResponse
readList :: ReadS [AssociateTargetsWithJobResponse]
$creadList :: ReadS [AssociateTargetsWithJobResponse]
readsPrec :: Int -> ReadS AssociateTargetsWithJobResponse
$creadsPrec :: Int -> ReadS AssociateTargetsWithJobResponse
Prelude.Read, Int -> AssociateTargetsWithJobResponse -> ShowS
[AssociateTargetsWithJobResponse] -> ShowS
AssociateTargetsWithJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateTargetsWithJobResponse] -> ShowS
$cshowList :: [AssociateTargetsWithJobResponse] -> ShowS
show :: AssociateTargetsWithJobResponse -> String
$cshow :: AssociateTargetsWithJobResponse -> String
showsPrec :: Int -> AssociateTargetsWithJobResponse -> ShowS
$cshowsPrec :: Int -> AssociateTargetsWithJobResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateTargetsWithJobResponse x
-> AssociateTargetsWithJobResponse
forall x.
AssociateTargetsWithJobResponse
-> Rep AssociateTargetsWithJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateTargetsWithJobResponse x
-> AssociateTargetsWithJobResponse
$cfrom :: forall x.
AssociateTargetsWithJobResponse
-> Rep AssociateTargetsWithJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateTargetsWithJobResponse' 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:
--
-- 'description', 'associateTargetsWithJobResponse_description' - A short text description of the job.
--
-- 'jobArn', 'associateTargetsWithJobResponse_jobArn' - An ARN identifying the job.
--
-- 'jobId', 'associateTargetsWithJobResponse_jobId' - The unique identifier you assigned to this job when it was created.
--
-- 'httpStatus', 'associateTargetsWithJobResponse_httpStatus' - The response's http status code.
newAssociateTargetsWithJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateTargetsWithJobResponse
newAssociateTargetsWithJobResponse :: Int -> AssociateTargetsWithJobResponse
newAssociateTargetsWithJobResponse Int
pHttpStatus_ =
  AssociateTargetsWithJobResponse'
    { $sel:description:AssociateTargetsWithJobResponse' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:jobArn:AssociateTargetsWithJobResponse' :: Maybe Text
jobArn = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:AssociateTargetsWithJobResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateTargetsWithJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A short text description of the job.
associateTargetsWithJobResponse_description :: Lens.Lens' AssociateTargetsWithJobResponse (Prelude.Maybe Prelude.Text)
associateTargetsWithJobResponse_description :: Lens' AssociateTargetsWithJobResponse (Maybe Text)
associateTargetsWithJobResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateTargetsWithJobResponse' {Maybe Text
description :: Maybe Text
$sel:description:AssociateTargetsWithJobResponse' :: AssociateTargetsWithJobResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: AssociateTargetsWithJobResponse
s@AssociateTargetsWithJobResponse' {} Maybe Text
a -> AssociateTargetsWithJobResponse
s {$sel:description:AssociateTargetsWithJobResponse' :: Maybe Text
description = Maybe Text
a} :: AssociateTargetsWithJobResponse)

-- | An ARN identifying the job.
associateTargetsWithJobResponse_jobArn :: Lens.Lens' AssociateTargetsWithJobResponse (Prelude.Maybe Prelude.Text)
associateTargetsWithJobResponse_jobArn :: Lens' AssociateTargetsWithJobResponse (Maybe Text)
associateTargetsWithJobResponse_jobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateTargetsWithJobResponse' {Maybe Text
jobArn :: Maybe Text
$sel:jobArn:AssociateTargetsWithJobResponse' :: AssociateTargetsWithJobResponse -> Maybe Text
jobArn} -> Maybe Text
jobArn) (\s :: AssociateTargetsWithJobResponse
s@AssociateTargetsWithJobResponse' {} Maybe Text
a -> AssociateTargetsWithJobResponse
s {$sel:jobArn:AssociateTargetsWithJobResponse' :: Maybe Text
jobArn = Maybe Text
a} :: AssociateTargetsWithJobResponse)

-- | The unique identifier you assigned to this job when it was created.
associateTargetsWithJobResponse_jobId :: Lens.Lens' AssociateTargetsWithJobResponse (Prelude.Maybe Prelude.Text)
associateTargetsWithJobResponse_jobId :: Lens' AssociateTargetsWithJobResponse (Maybe Text)
associateTargetsWithJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateTargetsWithJobResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:AssociateTargetsWithJobResponse' :: AssociateTargetsWithJobResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: AssociateTargetsWithJobResponse
s@AssociateTargetsWithJobResponse' {} Maybe Text
a -> AssociateTargetsWithJobResponse
s {$sel:jobId:AssociateTargetsWithJobResponse' :: Maybe Text
jobId = Maybe Text
a} :: AssociateTargetsWithJobResponse)

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

instance
  Prelude.NFData
    AssociateTargetsWithJobResponse
  where
  rnf :: AssociateTargetsWithJobResponse -> ()
rnf AssociateTargetsWithJobResponse' {Int
Maybe Text
httpStatus :: Int
jobId :: Maybe Text
jobArn :: Maybe Text
description :: Maybe Text
$sel:httpStatus:AssociateTargetsWithJobResponse' :: AssociateTargetsWithJobResponse -> Int
$sel:jobId:AssociateTargetsWithJobResponse' :: AssociateTargetsWithJobResponse -> Maybe Text
$sel:jobArn:AssociateTargetsWithJobResponse' :: AssociateTargetsWithJobResponse -> Maybe Text
$sel:description:AssociateTargetsWithJobResponse' :: AssociateTargetsWithJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus