{-# 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.Evidently.ListSegmentReferences
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this operation to find which experiments or launches are using a
-- specified segment.
--
-- This operation returns paginated results.
module Amazonka.Evidently.ListSegmentReferences
  ( -- * Creating a Request
    ListSegmentReferences (..),
    newListSegmentReferences,

    -- * Request Lenses
    listSegmentReferences_maxResults,
    listSegmentReferences_nextToken,
    listSegmentReferences_segment,
    listSegmentReferences_type,

    -- * Destructuring the Response
    ListSegmentReferencesResponse (..),
    newListSegmentReferencesResponse,

    -- * Response Lenses
    listSegmentReferencesResponse_nextToken,
    listSegmentReferencesResponse_referencedBy,
    listSegmentReferencesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListSegmentReferences' smart constructor.
data ListSegmentReferences = ListSegmentReferences'
  { -- | The maximum number of results to include in the response. If you omit
    -- this, the default of 50 is used.
    ListSegmentReferences -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to use when requesting the next set of results. You received
    -- this token from a previous @ListSegmentReferences@ operation.
    ListSegmentReferences -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the segment that you want to view information for.
    ListSegmentReferences -> Text
segment :: Prelude.Text,
    -- | Specifies whether to return information about launches or experiments
    -- that use this segment.
    ListSegmentReferences -> SegmentReferenceResourceType
type' :: SegmentReferenceResourceType
  }
  deriving (ListSegmentReferences -> ListSegmentReferences -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSegmentReferences -> ListSegmentReferences -> Bool
$c/= :: ListSegmentReferences -> ListSegmentReferences -> Bool
== :: ListSegmentReferences -> ListSegmentReferences -> Bool
$c== :: ListSegmentReferences -> ListSegmentReferences -> Bool
Prelude.Eq, ReadPrec [ListSegmentReferences]
ReadPrec ListSegmentReferences
Int -> ReadS ListSegmentReferences
ReadS [ListSegmentReferences]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSegmentReferences]
$creadListPrec :: ReadPrec [ListSegmentReferences]
readPrec :: ReadPrec ListSegmentReferences
$creadPrec :: ReadPrec ListSegmentReferences
readList :: ReadS [ListSegmentReferences]
$creadList :: ReadS [ListSegmentReferences]
readsPrec :: Int -> ReadS ListSegmentReferences
$creadsPrec :: Int -> ReadS ListSegmentReferences
Prelude.Read, Int -> ListSegmentReferences -> ShowS
[ListSegmentReferences] -> ShowS
ListSegmentReferences -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSegmentReferences] -> ShowS
$cshowList :: [ListSegmentReferences] -> ShowS
show :: ListSegmentReferences -> String
$cshow :: ListSegmentReferences -> String
showsPrec :: Int -> ListSegmentReferences -> ShowS
$cshowsPrec :: Int -> ListSegmentReferences -> ShowS
Prelude.Show, forall x. Rep ListSegmentReferences x -> ListSegmentReferences
forall x. ListSegmentReferences -> Rep ListSegmentReferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSegmentReferences x -> ListSegmentReferences
$cfrom :: forall x. ListSegmentReferences -> Rep ListSegmentReferences x
Prelude.Generic)

-- |
-- Create a value of 'ListSegmentReferences' 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:
--
-- 'maxResults', 'listSegmentReferences_maxResults' - The maximum number of results to include in the response. If you omit
-- this, the default of 50 is used.
--
-- 'nextToken', 'listSegmentReferences_nextToken' - The token to use when requesting the next set of results. You received
-- this token from a previous @ListSegmentReferences@ operation.
--
-- 'segment', 'listSegmentReferences_segment' - The ARN of the segment that you want to view information for.
--
-- 'type'', 'listSegmentReferences_type' - Specifies whether to return information about launches or experiments
-- that use this segment.
newListSegmentReferences ::
  -- | 'segment'
  Prelude.Text ->
  -- | 'type''
  SegmentReferenceResourceType ->
  ListSegmentReferences
newListSegmentReferences :: Text -> SegmentReferenceResourceType -> ListSegmentReferences
newListSegmentReferences Text
pSegment_ SegmentReferenceResourceType
pType_ =
  ListSegmentReferences'
    { $sel:maxResults:ListSegmentReferences' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSegmentReferences' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:segment:ListSegmentReferences' :: Text
segment = Text
pSegment_,
      $sel:type':ListSegmentReferences' :: SegmentReferenceResourceType
type' = SegmentReferenceResourceType
pType_
    }

-- | The maximum number of results to include in the response. If you omit
-- this, the default of 50 is used.
listSegmentReferences_maxResults :: Lens.Lens' ListSegmentReferences (Prelude.Maybe Prelude.Natural)
listSegmentReferences_maxResults :: Lens' ListSegmentReferences (Maybe Natural)
listSegmentReferences_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSegmentReferences' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListSegmentReferences' :: ListSegmentReferences -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListSegmentReferences
s@ListSegmentReferences' {} Maybe Natural
a -> ListSegmentReferences
s {$sel:maxResults:ListSegmentReferences' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListSegmentReferences)

-- | The token to use when requesting the next set of results. You received
-- this token from a previous @ListSegmentReferences@ operation.
listSegmentReferences_nextToken :: Lens.Lens' ListSegmentReferences (Prelude.Maybe Prelude.Text)
listSegmentReferences_nextToken :: Lens' ListSegmentReferences (Maybe Text)
listSegmentReferences_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSegmentReferences' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSegmentReferences' :: ListSegmentReferences -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSegmentReferences
s@ListSegmentReferences' {} Maybe Text
a -> ListSegmentReferences
s {$sel:nextToken:ListSegmentReferences' :: Maybe Text
nextToken = Maybe Text
a} :: ListSegmentReferences)

-- | The ARN of the segment that you want to view information for.
listSegmentReferences_segment :: Lens.Lens' ListSegmentReferences Prelude.Text
listSegmentReferences_segment :: Lens' ListSegmentReferences Text
listSegmentReferences_segment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSegmentReferences' {Text
segment :: Text
$sel:segment:ListSegmentReferences' :: ListSegmentReferences -> Text
segment} -> Text
segment) (\s :: ListSegmentReferences
s@ListSegmentReferences' {} Text
a -> ListSegmentReferences
s {$sel:segment:ListSegmentReferences' :: Text
segment = Text
a} :: ListSegmentReferences)

-- | Specifies whether to return information about launches or experiments
-- that use this segment.
listSegmentReferences_type :: Lens.Lens' ListSegmentReferences SegmentReferenceResourceType
listSegmentReferences_type :: Lens' ListSegmentReferences SegmentReferenceResourceType
listSegmentReferences_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSegmentReferences' {SegmentReferenceResourceType
type' :: SegmentReferenceResourceType
$sel:type':ListSegmentReferences' :: ListSegmentReferences -> SegmentReferenceResourceType
type'} -> SegmentReferenceResourceType
type') (\s :: ListSegmentReferences
s@ListSegmentReferences' {} SegmentReferenceResourceType
a -> ListSegmentReferences
s {$sel:type':ListSegmentReferences' :: SegmentReferenceResourceType
type' = SegmentReferenceResourceType
a} :: ListSegmentReferences)

instance Core.AWSPager ListSegmentReferences where
  page :: ListSegmentReferences
-> AWSResponse ListSegmentReferences -> Maybe ListSegmentReferences
page ListSegmentReferences
rq AWSResponse ListSegmentReferences
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSegmentReferences
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSegmentReferencesResponse (Maybe Text)
listSegmentReferencesResponse_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 ListSegmentReferences
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSegmentReferencesResponse (Maybe [RefResource])
listSegmentReferencesResponse_referencedBy
            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
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListSegmentReferences
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSegmentReferences (Maybe Text)
listSegmentReferences_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSegmentReferences
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSegmentReferencesResponse (Maybe Text)
listSegmentReferencesResponse_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 ListSegmentReferences where
  type
    AWSResponse ListSegmentReferences =
      ListSegmentReferencesResponse
  request :: (Service -> Service)
-> ListSegmentReferences -> Request ListSegmentReferences
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListSegmentReferences
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListSegmentReferences)))
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 [RefResource] -> Int -> ListSegmentReferencesResponse
ListSegmentReferencesResponse'
            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
"referencedBy" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListSegmentReferences where
  hashWithSalt :: Int -> ListSegmentReferences -> Int
hashWithSalt Int
_salt ListSegmentReferences' {Maybe Natural
Maybe Text
Text
SegmentReferenceResourceType
type' :: SegmentReferenceResourceType
segment :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListSegmentReferences' :: ListSegmentReferences -> SegmentReferenceResourceType
$sel:segment:ListSegmentReferences' :: ListSegmentReferences -> Text
$sel:nextToken:ListSegmentReferences' :: ListSegmentReferences -> Maybe Text
$sel:maxResults:ListSegmentReferences' :: ListSegmentReferences -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
segment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SegmentReferenceResourceType
type'

instance Prelude.NFData ListSegmentReferences where
  rnf :: ListSegmentReferences -> ()
rnf ListSegmentReferences' {Maybe Natural
Maybe Text
Text
SegmentReferenceResourceType
type' :: SegmentReferenceResourceType
segment :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListSegmentReferences' :: ListSegmentReferences -> SegmentReferenceResourceType
$sel:segment:ListSegmentReferences' :: ListSegmentReferences -> Text
$sel:nextToken:ListSegmentReferences' :: ListSegmentReferences -> Maybe Text
$sel:maxResults:ListSegmentReferences' :: ListSegmentReferences -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      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
segment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SegmentReferenceResourceType
type'

instance Data.ToHeaders ListSegmentReferences where
  toHeaders :: ListSegmentReferences -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath ListSegmentReferences where
  toPath :: ListSegmentReferences -> ByteString
toPath ListSegmentReferences' {Maybe Natural
Maybe Text
Text
SegmentReferenceResourceType
type' :: SegmentReferenceResourceType
segment :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListSegmentReferences' :: ListSegmentReferences -> SegmentReferenceResourceType
$sel:segment:ListSegmentReferences' :: ListSegmentReferences -> Text
$sel:nextToken:ListSegmentReferences' :: ListSegmentReferences -> Maybe Text
$sel:maxResults:ListSegmentReferences' :: ListSegmentReferences -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/segments/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
segment, ByteString
"/references"]

instance Data.ToQuery ListSegmentReferences where
  toQuery :: ListSegmentReferences -> QueryString
toQuery ListSegmentReferences' {Maybe Natural
Maybe Text
Text
SegmentReferenceResourceType
type' :: SegmentReferenceResourceType
segment :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListSegmentReferences' :: ListSegmentReferences -> SegmentReferenceResourceType
$sel:segment:ListSegmentReferences' :: ListSegmentReferences -> Text
$sel:nextToken:ListSegmentReferences' :: ListSegmentReferences -> Maybe Text
$sel:maxResults:ListSegmentReferences' :: ListSegmentReferences -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: SegmentReferenceResourceType
type'
      ]

-- | /See:/ 'newListSegmentReferencesResponse' smart constructor.
data ListSegmentReferencesResponse = ListSegmentReferencesResponse'
  { -- | The token to use in a subsequent @ListSegmentReferences@ operation to
    -- return the next set of results.
    ListSegmentReferencesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An array of structures, where each structure contains information about
    -- one experiment or launch that uses this segment.
    ListSegmentReferencesResponse -> Maybe [RefResource]
referencedBy :: Prelude.Maybe [RefResource],
    -- | The response's http status code.
    ListSegmentReferencesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListSegmentReferencesResponse
-> ListSegmentReferencesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSegmentReferencesResponse
-> ListSegmentReferencesResponse -> Bool
$c/= :: ListSegmentReferencesResponse
-> ListSegmentReferencesResponse -> Bool
== :: ListSegmentReferencesResponse
-> ListSegmentReferencesResponse -> Bool
$c== :: ListSegmentReferencesResponse
-> ListSegmentReferencesResponse -> Bool
Prelude.Eq, ReadPrec [ListSegmentReferencesResponse]
ReadPrec ListSegmentReferencesResponse
Int -> ReadS ListSegmentReferencesResponse
ReadS [ListSegmentReferencesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSegmentReferencesResponse]
$creadListPrec :: ReadPrec [ListSegmentReferencesResponse]
readPrec :: ReadPrec ListSegmentReferencesResponse
$creadPrec :: ReadPrec ListSegmentReferencesResponse
readList :: ReadS [ListSegmentReferencesResponse]
$creadList :: ReadS [ListSegmentReferencesResponse]
readsPrec :: Int -> ReadS ListSegmentReferencesResponse
$creadsPrec :: Int -> ReadS ListSegmentReferencesResponse
Prelude.Read, Int -> ListSegmentReferencesResponse -> ShowS
[ListSegmentReferencesResponse] -> ShowS
ListSegmentReferencesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSegmentReferencesResponse] -> ShowS
$cshowList :: [ListSegmentReferencesResponse] -> ShowS
show :: ListSegmentReferencesResponse -> String
$cshow :: ListSegmentReferencesResponse -> String
showsPrec :: Int -> ListSegmentReferencesResponse -> ShowS
$cshowsPrec :: Int -> ListSegmentReferencesResponse -> ShowS
Prelude.Show, forall x.
Rep ListSegmentReferencesResponse x
-> ListSegmentReferencesResponse
forall x.
ListSegmentReferencesResponse
-> Rep ListSegmentReferencesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSegmentReferencesResponse x
-> ListSegmentReferencesResponse
$cfrom :: forall x.
ListSegmentReferencesResponse
-> Rep ListSegmentReferencesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSegmentReferencesResponse' 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', 'listSegmentReferencesResponse_nextToken' - The token to use in a subsequent @ListSegmentReferences@ operation to
-- return the next set of results.
--
-- 'referencedBy', 'listSegmentReferencesResponse_referencedBy' - An array of structures, where each structure contains information about
-- one experiment or launch that uses this segment.
--
-- 'httpStatus', 'listSegmentReferencesResponse_httpStatus' - The response's http status code.
newListSegmentReferencesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSegmentReferencesResponse
newListSegmentReferencesResponse :: Int -> ListSegmentReferencesResponse
newListSegmentReferencesResponse Int
pHttpStatus_ =
  ListSegmentReferencesResponse'
    { $sel:nextToken:ListSegmentReferencesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:referencedBy:ListSegmentReferencesResponse' :: Maybe [RefResource]
referencedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSegmentReferencesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token to use in a subsequent @ListSegmentReferences@ operation to
-- return the next set of results.
listSegmentReferencesResponse_nextToken :: Lens.Lens' ListSegmentReferencesResponse (Prelude.Maybe Prelude.Text)
listSegmentReferencesResponse_nextToken :: Lens' ListSegmentReferencesResponse (Maybe Text)
listSegmentReferencesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSegmentReferencesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSegmentReferencesResponse' :: ListSegmentReferencesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSegmentReferencesResponse
s@ListSegmentReferencesResponse' {} Maybe Text
a -> ListSegmentReferencesResponse
s {$sel:nextToken:ListSegmentReferencesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSegmentReferencesResponse)

-- | An array of structures, where each structure contains information about
-- one experiment or launch that uses this segment.
listSegmentReferencesResponse_referencedBy :: Lens.Lens' ListSegmentReferencesResponse (Prelude.Maybe [RefResource])
listSegmentReferencesResponse_referencedBy :: Lens' ListSegmentReferencesResponse (Maybe [RefResource])
listSegmentReferencesResponse_referencedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSegmentReferencesResponse' {Maybe [RefResource]
referencedBy :: Maybe [RefResource]
$sel:referencedBy:ListSegmentReferencesResponse' :: ListSegmentReferencesResponse -> Maybe [RefResource]
referencedBy} -> Maybe [RefResource]
referencedBy) (\s :: ListSegmentReferencesResponse
s@ListSegmentReferencesResponse' {} Maybe [RefResource]
a -> ListSegmentReferencesResponse
s {$sel:referencedBy:ListSegmentReferencesResponse' :: Maybe [RefResource]
referencedBy = Maybe [RefResource]
a} :: ListSegmentReferencesResponse) 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.
listSegmentReferencesResponse_httpStatus :: Lens.Lens' ListSegmentReferencesResponse Prelude.Int
listSegmentReferencesResponse_httpStatus :: Lens' ListSegmentReferencesResponse Int
listSegmentReferencesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSegmentReferencesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListSegmentReferencesResponse' :: ListSegmentReferencesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListSegmentReferencesResponse
s@ListSegmentReferencesResponse' {} Int
a -> ListSegmentReferencesResponse
s {$sel:httpStatus:ListSegmentReferencesResponse' :: Int
httpStatus = Int
a} :: ListSegmentReferencesResponse)

instance Prelude.NFData ListSegmentReferencesResponse where
  rnf :: ListSegmentReferencesResponse -> ()
rnf ListSegmentReferencesResponse' {Int
Maybe [RefResource]
Maybe Text
httpStatus :: Int
referencedBy :: Maybe [RefResource]
nextToken :: Maybe Text
$sel:httpStatus:ListSegmentReferencesResponse' :: ListSegmentReferencesResponse -> Int
$sel:referencedBy:ListSegmentReferencesResponse' :: ListSegmentReferencesResponse -> Maybe [RefResource]
$sel:nextToken:ListSegmentReferencesResponse' :: ListSegmentReferencesResponse -> 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 [RefResource]
referencedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus