{-# 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.ListTargetsByRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the targets assigned to the specified rule.
--
-- This operation returns paginated results.
module Amazonka.CloudWatchEvents.ListTargetsByRule
  ( -- * Creating a Request
    ListTargetsByRule (..),
    newListTargetsByRule,

    -- * Request Lenses
    listTargetsByRule_eventBusName,
    listTargetsByRule_limit,
    listTargetsByRule_nextToken,
    listTargetsByRule_rule,

    -- * Destructuring the Response
    ListTargetsByRuleResponse (..),
    newListTargetsByRuleResponse,

    -- * Response Lenses
    listTargetsByRuleResponse_nextToken,
    listTargetsByRuleResponse_targets,
    listTargetsByRuleResponse_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:/ 'newListTargetsByRule' smart constructor.
data ListTargetsByRule = ListTargetsByRule'
  { -- | The name or ARN of the event bus associated with the rule. If you omit
    -- this, the default event bus is used.
    ListTargetsByRule -> Maybe Text
eventBusName :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of results to return.
    ListTargetsByRule -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The token returned by a previous call to retrieve the next set of
    -- results.
    ListTargetsByRule -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the rule.
    ListTargetsByRule -> Text
rule :: Prelude.Text
  }
  deriving (ListTargetsByRule -> ListTargetsByRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTargetsByRule -> ListTargetsByRule -> Bool
$c/= :: ListTargetsByRule -> ListTargetsByRule -> Bool
== :: ListTargetsByRule -> ListTargetsByRule -> Bool
$c== :: ListTargetsByRule -> ListTargetsByRule -> Bool
Prelude.Eq, ReadPrec [ListTargetsByRule]
ReadPrec ListTargetsByRule
Int -> ReadS ListTargetsByRule
ReadS [ListTargetsByRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTargetsByRule]
$creadListPrec :: ReadPrec [ListTargetsByRule]
readPrec :: ReadPrec ListTargetsByRule
$creadPrec :: ReadPrec ListTargetsByRule
readList :: ReadS [ListTargetsByRule]
$creadList :: ReadS [ListTargetsByRule]
readsPrec :: Int -> ReadS ListTargetsByRule
$creadsPrec :: Int -> ReadS ListTargetsByRule
Prelude.Read, Int -> ListTargetsByRule -> ShowS
[ListTargetsByRule] -> ShowS
ListTargetsByRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTargetsByRule] -> ShowS
$cshowList :: [ListTargetsByRule] -> ShowS
show :: ListTargetsByRule -> String
$cshow :: ListTargetsByRule -> String
showsPrec :: Int -> ListTargetsByRule -> ShowS
$cshowsPrec :: Int -> ListTargetsByRule -> ShowS
Prelude.Show, forall x. Rep ListTargetsByRule x -> ListTargetsByRule
forall x. ListTargetsByRule -> Rep ListTargetsByRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTargetsByRule x -> ListTargetsByRule
$cfrom :: forall x. ListTargetsByRule -> Rep ListTargetsByRule x
Prelude.Generic)

-- |
-- Create a value of 'ListTargetsByRule' 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', 'listTargetsByRule_eventBusName' - The name or ARN of the event bus associated with the rule. If you omit
-- this, the default event bus is used.
--
-- 'limit', 'listTargetsByRule_limit' - The maximum number of results to return.
--
-- 'nextToken', 'listTargetsByRule_nextToken' - The token returned by a previous call to retrieve the next set of
-- results.
--
-- 'rule', 'listTargetsByRule_rule' - The name of the rule.
newListTargetsByRule ::
  -- | 'rule'
  Prelude.Text ->
  ListTargetsByRule
newListTargetsByRule :: Text -> ListTargetsByRule
newListTargetsByRule Text
pRule_ =
  ListTargetsByRule'
    { $sel:eventBusName:ListTargetsByRule' :: Maybe Text
eventBusName = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ListTargetsByRule' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTargetsByRule' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:rule:ListTargetsByRule' :: Text
rule = Text
pRule_
    }

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

-- | The maximum number of results to return.
listTargetsByRule_limit :: Lens.Lens' ListTargetsByRule (Prelude.Maybe Prelude.Natural)
listTargetsByRule_limit :: Lens' ListTargetsByRule (Maybe Natural)
listTargetsByRule_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTargetsByRule' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListTargetsByRule' :: ListTargetsByRule -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListTargetsByRule
s@ListTargetsByRule' {} Maybe Natural
a -> ListTargetsByRule
s {$sel:limit:ListTargetsByRule' :: Maybe Natural
limit = Maybe Natural
a} :: ListTargetsByRule)

-- | The token returned by a previous call to retrieve the next set of
-- results.
listTargetsByRule_nextToken :: Lens.Lens' ListTargetsByRule (Prelude.Maybe Prelude.Text)
listTargetsByRule_nextToken :: Lens' ListTargetsByRule (Maybe Text)
listTargetsByRule_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTargetsByRule' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTargetsByRule' :: ListTargetsByRule -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTargetsByRule
s@ListTargetsByRule' {} Maybe Text
a -> ListTargetsByRule
s {$sel:nextToken:ListTargetsByRule' :: Maybe Text
nextToken = Maybe Text
a} :: ListTargetsByRule)

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

instance Core.AWSPager ListTargetsByRule where
  page :: ListTargetsByRule
-> AWSResponse ListTargetsByRule -> Maybe ListTargetsByRule
page ListTargetsByRule
rq AWSResponse ListTargetsByRule
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTargetsByRule
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTargetsByRuleResponse (Maybe Text)
listTargetsByRuleResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTargetsByRule
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTargetsByRuleResponse (Maybe (NonEmpty Target))
listTargetsByRuleResponse_targets
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall l. IsList l => l -> [Item l]
Prelude.toList
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListTargetsByRule
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTargetsByRule (Maybe Text)
listTargetsByRule_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTargetsByRule
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTargetsByRuleResponse (Maybe Text)
listTargetsByRuleResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListTargetsByRule where
  type
    AWSResponse ListTargetsByRule =
      ListTargetsByRuleResponse
  request :: (Service -> Service)
-> ListTargetsByRule -> Request ListTargetsByRule
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 ListTargetsByRule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTargetsByRule)))
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 (NonEmpty Target) -> Int -> ListTargetsByRuleResponse
ListTargetsByRuleResponse'
            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
"NextToken")
            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
"Targets")
            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 ListTargetsByRule where
  hashWithSalt :: Int -> ListTargetsByRule -> Int
hashWithSalt Int
_salt ListTargetsByRule' {Maybe Natural
Maybe Text
Text
rule :: Text
nextToken :: Maybe Text
limit :: Maybe Natural
eventBusName :: Maybe Text
$sel:rule:ListTargetsByRule' :: ListTargetsByRule -> Text
$sel:nextToken:ListTargetsByRule' :: ListTargetsByRule -> Maybe Text
$sel:limit:ListTargetsByRule' :: ListTargetsByRule -> Maybe Natural
$sel:eventBusName:ListTargetsByRule' :: ListTargetsByRule -> 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` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
rule

instance Prelude.NFData ListTargetsByRule where
  rnf :: ListTargetsByRule -> ()
rnf ListTargetsByRule' {Maybe Natural
Maybe Text
Text
rule :: Text
nextToken :: Maybe Text
limit :: Maybe Natural
eventBusName :: Maybe Text
$sel:rule:ListTargetsByRule' :: ListTargetsByRule -> Text
$sel:nextToken:ListTargetsByRule' :: ListTargetsByRule -> Maybe Text
$sel:limit:ListTargetsByRule' :: ListTargetsByRule -> Maybe Natural
$sel:eventBusName:ListTargetsByRule' :: ListTargetsByRule -> 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 Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
rule

instance Data.ToHeaders ListTargetsByRule where
  toHeaders :: ListTargetsByRule -> 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.ListTargetsByRule" ::
                          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 ListTargetsByRule where
  toJSON :: ListTargetsByRule -> Value
toJSON ListTargetsByRule' {Maybe Natural
Maybe Text
Text
rule :: Text
nextToken :: Maybe Text
limit :: Maybe Natural
eventBusName :: Maybe Text
$sel:rule:ListTargetsByRule' :: ListTargetsByRule -> Text
$sel:nextToken:ListTargetsByRule' :: ListTargetsByRule -> Maybe Text
$sel:limit:ListTargetsByRule' :: ListTargetsByRule -> Maybe Natural
$sel:eventBusName:ListTargetsByRule' :: ListTargetsByRule -> 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,
            (Key
"Limit" 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 Natural
limit,
            (Key
"NextToken" 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
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"Rule" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
rule)
          ]
      )

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

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

-- | /See:/ 'newListTargetsByRuleResponse' smart constructor.
data ListTargetsByRuleResponse = ListTargetsByRuleResponse'
  { -- | Indicates whether there are additional results to retrieve. If there are
    -- no more results, the value is null.
    ListTargetsByRuleResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The targets assigned to the rule.
    ListTargetsByRuleResponse -> Maybe (NonEmpty Target)
targets :: Prelude.Maybe (Prelude.NonEmpty Target),
    -- | The response's http status code.
    ListTargetsByRuleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTargetsByRuleResponse -> ListTargetsByRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTargetsByRuleResponse -> ListTargetsByRuleResponse -> Bool
$c/= :: ListTargetsByRuleResponse -> ListTargetsByRuleResponse -> Bool
== :: ListTargetsByRuleResponse -> ListTargetsByRuleResponse -> Bool
$c== :: ListTargetsByRuleResponse -> ListTargetsByRuleResponse -> Bool
Prelude.Eq, ReadPrec [ListTargetsByRuleResponse]
ReadPrec ListTargetsByRuleResponse
Int -> ReadS ListTargetsByRuleResponse
ReadS [ListTargetsByRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTargetsByRuleResponse]
$creadListPrec :: ReadPrec [ListTargetsByRuleResponse]
readPrec :: ReadPrec ListTargetsByRuleResponse
$creadPrec :: ReadPrec ListTargetsByRuleResponse
readList :: ReadS [ListTargetsByRuleResponse]
$creadList :: ReadS [ListTargetsByRuleResponse]
readsPrec :: Int -> ReadS ListTargetsByRuleResponse
$creadsPrec :: Int -> ReadS ListTargetsByRuleResponse
Prelude.Read, Int -> ListTargetsByRuleResponse -> ShowS
[ListTargetsByRuleResponse] -> ShowS
ListTargetsByRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTargetsByRuleResponse] -> ShowS
$cshowList :: [ListTargetsByRuleResponse] -> ShowS
show :: ListTargetsByRuleResponse -> String
$cshow :: ListTargetsByRuleResponse -> String
showsPrec :: Int -> ListTargetsByRuleResponse -> ShowS
$cshowsPrec :: Int -> ListTargetsByRuleResponse -> ShowS
Prelude.Show, forall x.
Rep ListTargetsByRuleResponse x -> ListTargetsByRuleResponse
forall x.
ListTargetsByRuleResponse -> Rep ListTargetsByRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTargetsByRuleResponse x -> ListTargetsByRuleResponse
$cfrom :: forall x.
ListTargetsByRuleResponse -> Rep ListTargetsByRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTargetsByRuleResponse' 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:
--
-- 'nextToken', 'listTargetsByRuleResponse_nextToken' - Indicates whether there are additional results to retrieve. If there are
-- no more results, the value is null.
--
-- 'targets', 'listTargetsByRuleResponse_targets' - The targets assigned to the rule.
--
-- 'httpStatus', 'listTargetsByRuleResponse_httpStatus' - The response's http status code.
newListTargetsByRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTargetsByRuleResponse
newListTargetsByRuleResponse :: Int -> ListTargetsByRuleResponse
newListTargetsByRuleResponse Int
pHttpStatus_ =
  ListTargetsByRuleResponse'
    { $sel:nextToken:ListTargetsByRuleResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:targets:ListTargetsByRuleResponse' :: Maybe (NonEmpty Target)
targets = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTargetsByRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates whether there are additional results to retrieve. If there are
-- no more results, the value is null.
listTargetsByRuleResponse_nextToken :: Lens.Lens' ListTargetsByRuleResponse (Prelude.Maybe Prelude.Text)
listTargetsByRuleResponse_nextToken :: Lens' ListTargetsByRuleResponse (Maybe Text)
listTargetsByRuleResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTargetsByRuleResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTargetsByRuleResponse' :: ListTargetsByRuleResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTargetsByRuleResponse
s@ListTargetsByRuleResponse' {} Maybe Text
a -> ListTargetsByRuleResponse
s {$sel:nextToken:ListTargetsByRuleResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTargetsByRuleResponse)

-- | The targets assigned to the rule.
listTargetsByRuleResponse_targets :: Lens.Lens' ListTargetsByRuleResponse (Prelude.Maybe (Prelude.NonEmpty Target))
listTargetsByRuleResponse_targets :: Lens' ListTargetsByRuleResponse (Maybe (NonEmpty Target))
listTargetsByRuleResponse_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTargetsByRuleResponse' {Maybe (NonEmpty Target)
targets :: Maybe (NonEmpty Target)
$sel:targets:ListTargetsByRuleResponse' :: ListTargetsByRuleResponse -> Maybe (NonEmpty Target)
targets} -> Maybe (NonEmpty Target)
targets) (\s :: ListTargetsByRuleResponse
s@ListTargetsByRuleResponse' {} Maybe (NonEmpty Target)
a -> ListTargetsByRuleResponse
s {$sel:targets:ListTargetsByRuleResponse' :: Maybe (NonEmpty Target)
targets = Maybe (NonEmpty Target)
a} :: ListTargetsByRuleResponse) 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 response's http status code.
listTargetsByRuleResponse_httpStatus :: Lens.Lens' ListTargetsByRuleResponse Prelude.Int
listTargetsByRuleResponse_httpStatus :: Lens' ListTargetsByRuleResponse Int
listTargetsByRuleResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTargetsByRuleResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTargetsByRuleResponse' :: ListTargetsByRuleResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTargetsByRuleResponse
s@ListTargetsByRuleResponse' {} Int
a -> ListTargetsByRuleResponse
s {$sel:httpStatus:ListTargetsByRuleResponse' :: Int
httpStatus = Int
a} :: ListTargetsByRuleResponse)

instance Prelude.NFData ListTargetsByRuleResponse where
  rnf :: ListTargetsByRuleResponse -> ()
rnf ListTargetsByRuleResponse' {Int
Maybe (NonEmpty Target)
Maybe Text
httpStatus :: Int
targets :: Maybe (NonEmpty Target)
nextToken :: Maybe Text
$sel:httpStatus:ListTargetsByRuleResponse' :: ListTargetsByRuleResponse -> Int
$sel:targets:ListTargetsByRuleResponse' :: ListTargetsByRuleResponse -> Maybe (NonEmpty Target)
$sel:nextToken:ListTargetsByRuleResponse' :: ListTargetsByRuleResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Target)
targets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus