{-# 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.CloudWatchEvents.PutTargets
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds the specified targets to the specified rule, or updates the targets
-- if they are already associated with the rule.
--
-- Targets are the resources that are invoked when a rule is triggered.
--
-- Each rule can have up to five (5) targets associated with it at one
-- time.
--
-- You can configure the following as targets for Events:
--
-- -   <https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-api-destinations.html API destination>
--
-- -   <https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-api-gateway-target.html API Gateway>
--
-- -   Batch job queue
--
-- -   CloudWatch group
--
-- -   CodeBuild project
--
-- -   CodePipeline
--
-- -   EC2 @CreateSnapshot@ API call
--
-- -   EC2 Image Builder
--
-- -   EC2 @RebootInstances@ API call
--
-- -   EC2 @StopInstances@ API call
--
-- -   EC2 @TerminateInstances@ API call
--
-- -   ECS task
--
-- -   <https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-cross-account.html Event bus in a different account or Region>
--
-- -   <https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-bus-to-bus.html Event bus in the same account and Region>
--
-- -   Firehose delivery stream
--
-- -   Glue workflow
--
-- -   <https://docs.aws.amazon.com/incident-manager/latest/userguide/incident-creation.html#incident-tracking-auto-eventbridge Incident Manager response plan>
--
-- -   Inspector assessment template
--
-- -   Kinesis stream
--
-- -   Lambda function
--
-- -   Redshift cluster
--
-- -   SageMaker Pipeline
--
-- -   SNS topic
--
-- -   SQS queue
--
-- -   Step Functions state machine
--
-- -   Systems Manager Automation
--
-- -   Systems Manager OpsItem
--
-- -   Systems Manager Run Command
--
-- Creating rules with built-in targets is supported only in the Amazon Web
-- Services Management Console. The built-in targets are
-- @EC2 CreateSnapshot API call@, @EC2 RebootInstances API call@,
-- @EC2 StopInstances API call@, and @EC2 TerminateInstances API call@.
--
-- For some target types, @PutTargets@ provides target-specific parameters.
-- If the target is a Kinesis data stream, you can optionally specify which
-- shard the event goes to by using the @KinesisParameters@ argument. To
-- invoke a command on multiple EC2 instances with one rule, you can use
-- the @RunCommandParameters@ field.
--
-- To be able to make API calls against the resources that you own, Amazon
-- EventBridge needs the appropriate permissions. For Lambda and Amazon SNS
-- resources, EventBridge relies on resource-based policies. For EC2
-- instances, Kinesis Data Streams, Step Functions state machines and API
-- Gateway REST APIs, EventBridge relies on IAM roles that you specify in
-- the @RoleARN@ argument in @PutTargets@. For more information, see
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/auth-and-access-control-eventbridge.html Authentication and Access Control>
-- in the /Amazon EventBridge User Guide/.
--
-- If another Amazon Web Services account is in the same region and has
-- granted you permission (using @PutPermission@), you can send events to
-- that account. Set that account\'s event bus as a target of the rules in
-- your account. To send the matched events to the other account, specify
-- that account\'s event bus as the @Arn@ value when you run @PutTargets@.
-- If your account sends events to another account, your account is charged
-- for each sent event. Each event sent to another account is charged as a
-- custom event. The account receiving the event is not charged. For more
-- information, see
-- <http://aws.amazon.com/eventbridge/pricing/ Amazon EventBridge Pricing>.
--
-- @Input@, @InputPath@, and @InputTransformer@ are not available with
-- @PutTarget@ if the target is an event bus of a different Amazon Web
-- Services account.
--
-- If you are setting the event bus of another account as the target, and
-- that account granted permission to your account through an organization
-- instead of directly by the account ID, then you must specify a @RoleArn@
-- with proper permissions in the @Target@ structure. For more information,
-- see
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/eventbridge-cross-account-event-delivery.html Sending and Receiving Events Between Amazon Web Services Accounts>
-- in the /Amazon EventBridge User Guide/.
--
-- For more information about enabling cross-account events, see
-- <https://docs.aws.amazon.com/eventbridge/latest/APIReference/API_PutPermission.html PutPermission>.
--
-- __Input__, __InputPath__, and __InputTransformer__ are mutually
-- exclusive and optional parameters of a target. When a rule is triggered
-- due to a matched event:
--
-- -   If none of the following arguments are specified for a target, then
--     the entire event is passed to the target in JSON format (unless the
--     target is Amazon EC2 Run Command or Amazon ECS task, in which case
--     nothing from the event is passed to the target).
--
-- -   If __Input__ is specified in the form of valid JSON, then the
--     matched event is overridden with this constant.
--
-- -   If __InputPath__ is specified in the form of JSONPath (for example,
--     @$.detail@), then only the part of the event specified in the path
--     is passed to the target (for example, only the detail part of the
--     event is passed).
--
-- -   If __InputTransformer__ is specified, then one or more specified
--     JSONPaths are extracted from the event and used as values in a
--     template that you specify as the input to the target.
--
-- When you specify @InputPath@ or @InputTransformer@, you must use JSON
-- dot notation, not bracket notation.
--
-- When you add targets to a rule and the associated rule triggers soon
-- after, new or updated targets might not be immediately invoked. Allow a
-- short period of time for changes to take effect.
--
-- This action can partially fail if too many requests are made at the same
-- time. If that happens, @FailedEntryCount@ is non-zero in the response
-- and each entry in @FailedEntries@ provides the ID of the failed target
-- and the error code.
module Amazonka.CloudWatchEvents.PutTargets
  ( -- * Creating a Request
    PutTargets (..),
    newPutTargets,

    -- * Request Lenses
    putTargets_eventBusName,
    putTargets_rule,
    putTargets_targets,

    -- * Destructuring the Response
    PutTargetsResponse (..),
    newPutTargetsResponse,

    -- * Response Lenses
    putTargetsResponse_failedEntries,
    putTargetsResponse_failedEntryCount,
    putTargetsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutTargets' smart constructor.
data PutTargets = PutTargets'
  { -- | The name or ARN of the event bus associated with the rule. If you omit
    -- this, the default event bus is used.
    PutTargets -> Maybe Text
eventBusName :: Prelude.Maybe Prelude.Text,
    -- | The name of the rule.
    PutTargets -> Text
rule :: Prelude.Text,
    -- | The targets to update or add to the rule.
    PutTargets -> NonEmpty Target
targets :: Prelude.NonEmpty Target
  }
  deriving (PutTargets -> PutTargets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutTargets -> PutTargets -> Bool
$c/= :: PutTargets -> PutTargets -> Bool
== :: PutTargets -> PutTargets -> Bool
$c== :: PutTargets -> PutTargets -> Bool
Prelude.Eq, ReadPrec [PutTargets]
ReadPrec PutTargets
Int -> ReadS PutTargets
ReadS [PutTargets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutTargets]
$creadListPrec :: ReadPrec [PutTargets]
readPrec :: ReadPrec PutTargets
$creadPrec :: ReadPrec PutTargets
readList :: ReadS [PutTargets]
$creadList :: ReadS [PutTargets]
readsPrec :: Int -> ReadS PutTargets
$creadsPrec :: Int -> ReadS PutTargets
Prelude.Read, Int -> PutTargets -> ShowS
[PutTargets] -> ShowS
PutTargets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutTargets] -> ShowS
$cshowList :: [PutTargets] -> ShowS
show :: PutTargets -> String
$cshow :: PutTargets -> String
showsPrec :: Int -> PutTargets -> ShowS
$cshowsPrec :: Int -> PutTargets -> ShowS
Prelude.Show, forall x. Rep PutTargets x -> PutTargets
forall x. PutTargets -> Rep PutTargets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutTargets x -> PutTargets
$cfrom :: forall x. PutTargets -> Rep PutTargets x
Prelude.Generic)

-- |
-- Create a value of 'PutTargets' 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:
--
-- 'eventBusName', 'putTargets_eventBusName' - The name or ARN of the event bus associated with the rule. If you omit
-- this, the default event bus is used.
--
-- 'rule', 'putTargets_rule' - The name of the rule.
--
-- 'targets', 'putTargets_targets' - The targets to update or add to the rule.
newPutTargets ::
  -- | 'rule'
  Prelude.Text ->
  -- | 'targets'
  Prelude.NonEmpty Target ->
  PutTargets
newPutTargets :: Text -> NonEmpty Target -> PutTargets
newPutTargets Text
pRule_ NonEmpty Target
pTargets_ =
  PutTargets'
    { $sel:eventBusName:PutTargets' :: Maybe Text
eventBusName = forall a. Maybe a
Prelude.Nothing,
      $sel:rule:PutTargets' :: Text
rule = Text
pRule_,
      $sel:targets:PutTargets' :: NonEmpty Target
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 Target
pTargets_
    }

-- | The name or ARN of the event bus associated with the rule. If you omit
-- this, the default event bus is used.
putTargets_eventBusName :: Lens.Lens' PutTargets (Prelude.Maybe Prelude.Text)
putTargets_eventBusName :: Lens' PutTargets (Maybe Text)
putTargets_eventBusName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTargets' {Maybe Text
eventBusName :: Maybe Text
$sel:eventBusName:PutTargets' :: PutTargets -> Maybe Text
eventBusName} -> Maybe Text
eventBusName) (\s :: PutTargets
s@PutTargets' {} Maybe Text
a -> PutTargets
s {$sel:eventBusName:PutTargets' :: Maybe Text
eventBusName = Maybe Text
a} :: PutTargets)

-- | The name of the rule.
putTargets_rule :: Lens.Lens' PutTargets Prelude.Text
putTargets_rule :: Lens' PutTargets Text
putTargets_rule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTargets' {Text
rule :: Text
$sel:rule:PutTargets' :: PutTargets -> Text
rule} -> Text
rule) (\s :: PutTargets
s@PutTargets' {} Text
a -> PutTargets
s {$sel:rule:PutTargets' :: Text
rule = Text
a} :: PutTargets)

-- | The targets to update or add to the rule.
putTargets_targets :: Lens.Lens' PutTargets (Prelude.NonEmpty Target)
putTargets_targets :: Lens' PutTargets (NonEmpty Target)
putTargets_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTargets' {NonEmpty Target
targets :: NonEmpty Target
$sel:targets:PutTargets' :: PutTargets -> NonEmpty Target
targets} -> NonEmpty Target
targets) (\s :: PutTargets
s@PutTargets' {} NonEmpty Target
a -> PutTargets
s {$sel:targets:PutTargets' :: NonEmpty Target
targets = NonEmpty Target
a} :: PutTargets) 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 PutTargets where
  type AWSResponse PutTargets = PutTargetsResponse
  request :: (Service -> Service) -> PutTargets -> Request PutTargets
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 PutTargets
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutTargets)))
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 [PutTargetsResultEntry]
-> Maybe Int -> Int -> PutTargetsResponse
PutTargetsResponse'
            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
"FailedEntries" 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
"FailedEntryCount")
            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 PutTargets where
  hashWithSalt :: Int -> PutTargets -> Int
hashWithSalt Int
_salt PutTargets' {Maybe Text
NonEmpty Target
Text
targets :: NonEmpty Target
rule :: Text
eventBusName :: Maybe Text
$sel:targets:PutTargets' :: PutTargets -> NonEmpty Target
$sel:rule:PutTargets' :: PutTargets -> Text
$sel:eventBusName:PutTargets' :: PutTargets -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eventBusName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
rule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Target
targets

instance Prelude.NFData PutTargets where
  rnf :: PutTargets -> ()
rnf PutTargets' {Maybe Text
NonEmpty Target
Text
targets :: NonEmpty Target
rule :: Text
eventBusName :: Maybe Text
$sel:targets:PutTargets' :: PutTargets -> NonEmpty Target
$sel:rule:PutTargets' :: PutTargets -> Text
$sel:eventBusName:PutTargets' :: PutTargets -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eventBusName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
rule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Target
targets

instance Data.ToHeaders PutTargets where
  toHeaders :: PutTargets -> 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
"AWSEvents.PutTargets" :: 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 PutTargets where
  toJSON :: PutTargets -> Value
toJSON PutTargets' {Maybe Text
NonEmpty Target
Text
targets :: NonEmpty Target
rule :: Text
eventBusName :: Maybe Text
$sel:targets:PutTargets' :: PutTargets -> NonEmpty Target
$sel:rule:PutTargets' :: PutTargets -> Text
$sel:eventBusName:PutTargets' :: PutTargets -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EventBusName" 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
eventBusName,
            forall a. a -> Maybe a
Prelude.Just (Key
"Rule" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
rule),
            forall a. a -> Maybe a
Prelude.Just (Key
"Targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Target
targets)
          ]
      )

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

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

-- | /See:/ 'newPutTargetsResponse' smart constructor.
data PutTargetsResponse = PutTargetsResponse'
  { -- | The failed target entries.
    PutTargetsResponse -> Maybe [PutTargetsResultEntry]
failedEntries :: Prelude.Maybe [PutTargetsResultEntry],
    -- | The number of failed entries.
    PutTargetsResponse -> Maybe Int
failedEntryCount :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    PutTargetsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutTargetsResponse -> PutTargetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutTargetsResponse -> PutTargetsResponse -> Bool
$c/= :: PutTargetsResponse -> PutTargetsResponse -> Bool
== :: PutTargetsResponse -> PutTargetsResponse -> Bool
$c== :: PutTargetsResponse -> PutTargetsResponse -> Bool
Prelude.Eq, ReadPrec [PutTargetsResponse]
ReadPrec PutTargetsResponse
Int -> ReadS PutTargetsResponse
ReadS [PutTargetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutTargetsResponse]
$creadListPrec :: ReadPrec [PutTargetsResponse]
readPrec :: ReadPrec PutTargetsResponse
$creadPrec :: ReadPrec PutTargetsResponse
readList :: ReadS [PutTargetsResponse]
$creadList :: ReadS [PutTargetsResponse]
readsPrec :: Int -> ReadS PutTargetsResponse
$creadsPrec :: Int -> ReadS PutTargetsResponse
Prelude.Read, Int -> PutTargetsResponse -> ShowS
[PutTargetsResponse] -> ShowS
PutTargetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutTargetsResponse] -> ShowS
$cshowList :: [PutTargetsResponse] -> ShowS
show :: PutTargetsResponse -> String
$cshow :: PutTargetsResponse -> String
showsPrec :: Int -> PutTargetsResponse -> ShowS
$cshowsPrec :: Int -> PutTargetsResponse -> ShowS
Prelude.Show, forall x. Rep PutTargetsResponse x -> PutTargetsResponse
forall x. PutTargetsResponse -> Rep PutTargetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutTargetsResponse x -> PutTargetsResponse
$cfrom :: forall x. PutTargetsResponse -> Rep PutTargetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutTargetsResponse' 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:
--
-- 'failedEntries', 'putTargetsResponse_failedEntries' - The failed target entries.
--
-- 'failedEntryCount', 'putTargetsResponse_failedEntryCount' - The number of failed entries.
--
-- 'httpStatus', 'putTargetsResponse_httpStatus' - The response's http status code.
newPutTargetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutTargetsResponse
newPutTargetsResponse :: Int -> PutTargetsResponse
newPutTargetsResponse Int
pHttpStatus_ =
  PutTargetsResponse'
    { $sel:failedEntries:PutTargetsResponse' :: Maybe [PutTargetsResultEntry]
failedEntries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:failedEntryCount:PutTargetsResponse' :: Maybe Int
failedEntryCount = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutTargetsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The failed target entries.
putTargetsResponse_failedEntries :: Lens.Lens' PutTargetsResponse (Prelude.Maybe [PutTargetsResultEntry])
putTargetsResponse_failedEntries :: Lens' PutTargetsResponse (Maybe [PutTargetsResultEntry])
putTargetsResponse_failedEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTargetsResponse' {Maybe [PutTargetsResultEntry]
failedEntries :: Maybe [PutTargetsResultEntry]
$sel:failedEntries:PutTargetsResponse' :: PutTargetsResponse -> Maybe [PutTargetsResultEntry]
failedEntries} -> Maybe [PutTargetsResultEntry]
failedEntries) (\s :: PutTargetsResponse
s@PutTargetsResponse' {} Maybe [PutTargetsResultEntry]
a -> PutTargetsResponse
s {$sel:failedEntries:PutTargetsResponse' :: Maybe [PutTargetsResultEntry]
failedEntries = Maybe [PutTargetsResultEntry]
a} :: PutTargetsResponse) 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 number of failed entries.
putTargetsResponse_failedEntryCount :: Lens.Lens' PutTargetsResponse (Prelude.Maybe Prelude.Int)
putTargetsResponse_failedEntryCount :: Lens' PutTargetsResponse (Maybe Int)
putTargetsResponse_failedEntryCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutTargetsResponse' {Maybe Int
failedEntryCount :: Maybe Int
$sel:failedEntryCount:PutTargetsResponse' :: PutTargetsResponse -> Maybe Int
failedEntryCount} -> Maybe Int
failedEntryCount) (\s :: PutTargetsResponse
s@PutTargetsResponse' {} Maybe Int
a -> PutTargetsResponse
s {$sel:failedEntryCount:PutTargetsResponse' :: Maybe Int
failedEntryCount = Maybe Int
a} :: PutTargetsResponse)

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

instance Prelude.NFData PutTargetsResponse where
  rnf :: PutTargetsResponse -> ()
rnf PutTargetsResponse' {Int
Maybe Int
Maybe [PutTargetsResultEntry]
httpStatus :: Int
failedEntryCount :: Maybe Int
failedEntries :: Maybe [PutTargetsResultEntry]
$sel:httpStatus:PutTargetsResponse' :: PutTargetsResponse -> Int
$sel:failedEntryCount:PutTargetsResponse' :: PutTargetsResponse -> Maybe Int
$sel:failedEntries:PutTargetsResponse' :: PutTargetsResponse -> Maybe [PutTargetsResultEntry]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PutTargetsResultEntry]
failedEntries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
failedEntryCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus