{-# 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.Connect.ListContactReferences
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This API is in preview release for Amazon Connect and is subject to
-- change.
--
-- For the specified @referenceTypes@, returns a list of references
-- associated with the contact.
--
-- This operation returns paginated results.
module Amazonka.Connect.ListContactReferences
  ( -- * Creating a Request
    ListContactReferences (..),
    newListContactReferences,

    -- * Request Lenses
    listContactReferences_nextToken,
    listContactReferences_instanceId,
    listContactReferences_contactId,
    listContactReferences_referenceTypes,

    -- * Destructuring the Response
    ListContactReferencesResponse (..),
    newListContactReferencesResponse,

    -- * Response Lenses
    listContactReferencesResponse_nextToken,
    listContactReferencesResponse_referenceSummaryList,
    listContactReferencesResponse_httpStatus,
  )
where

import Amazonka.Connect.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:/ 'newListContactReferences' smart constructor.
data ListContactReferences = ListContactReferences'
  { -- | The token for the next set of results. Use the value returned in the
    -- previous response in the next request to retrieve the next set of
    -- results.
    --
    -- This is not expected to be set, because the value returned in the
    -- previous response is always null.
    ListContactReferences -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    ListContactReferences -> Text
instanceId :: Prelude.Text,
    -- | The identifier of the initial contact.
    ListContactReferences -> Text
contactId :: Prelude.Text,
    -- | The type of reference.
    ListContactReferences -> [ReferenceType]
referenceTypes :: [ReferenceType]
  }
  deriving (ListContactReferences -> ListContactReferences -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContactReferences -> ListContactReferences -> Bool
$c/= :: ListContactReferences -> ListContactReferences -> Bool
== :: ListContactReferences -> ListContactReferences -> Bool
$c== :: ListContactReferences -> ListContactReferences -> Bool
Prelude.Eq, ReadPrec [ListContactReferences]
ReadPrec ListContactReferences
Int -> ReadS ListContactReferences
ReadS [ListContactReferences]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContactReferences]
$creadListPrec :: ReadPrec [ListContactReferences]
readPrec :: ReadPrec ListContactReferences
$creadPrec :: ReadPrec ListContactReferences
readList :: ReadS [ListContactReferences]
$creadList :: ReadS [ListContactReferences]
readsPrec :: Int -> ReadS ListContactReferences
$creadsPrec :: Int -> ReadS ListContactReferences
Prelude.Read, Int -> ListContactReferences -> ShowS
[ListContactReferences] -> ShowS
ListContactReferences -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContactReferences] -> ShowS
$cshowList :: [ListContactReferences] -> ShowS
show :: ListContactReferences -> String
$cshow :: ListContactReferences -> String
showsPrec :: Int -> ListContactReferences -> ShowS
$cshowsPrec :: Int -> ListContactReferences -> ShowS
Prelude.Show, forall x. Rep ListContactReferences x -> ListContactReferences
forall x. ListContactReferences -> Rep ListContactReferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContactReferences x -> ListContactReferences
$cfrom :: forall x. ListContactReferences -> Rep ListContactReferences x
Prelude.Generic)

-- |
-- Create a value of 'ListContactReferences' 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', 'listContactReferences_nextToken' - The token for the next set of results. Use the value returned in the
-- previous response in the next request to retrieve the next set of
-- results.
--
-- This is not expected to be set, because the value returned in the
-- previous response is always null.
--
-- 'instanceId', 'listContactReferences_instanceId' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'contactId', 'listContactReferences_contactId' - The identifier of the initial contact.
--
-- 'referenceTypes', 'listContactReferences_referenceTypes' - The type of reference.
newListContactReferences ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'contactId'
  Prelude.Text ->
  ListContactReferences
newListContactReferences :: Text -> Text -> ListContactReferences
newListContactReferences Text
pInstanceId_ Text
pContactId_ =
  ListContactReferences'
    { $sel:nextToken:ListContactReferences' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:ListContactReferences' :: Text
instanceId = Text
pInstanceId_,
      $sel:contactId:ListContactReferences' :: Text
contactId = Text
pContactId_,
      $sel:referenceTypes:ListContactReferences' :: [ReferenceType]
referenceTypes = forall a. Monoid a => a
Prelude.mempty
    }

-- | The token for the next set of results. Use the value returned in the
-- previous response in the next request to retrieve the next set of
-- results.
--
-- This is not expected to be set, because the value returned in the
-- previous response is always null.
listContactReferences_nextToken :: Lens.Lens' ListContactReferences (Prelude.Maybe Prelude.Text)
listContactReferences_nextToken :: Lens' ListContactReferences (Maybe Text)
listContactReferences_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactReferences' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContactReferences' :: ListContactReferences -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContactReferences
s@ListContactReferences' {} Maybe Text
a -> ListContactReferences
s {$sel:nextToken:ListContactReferences' :: Maybe Text
nextToken = Maybe Text
a} :: ListContactReferences)

-- | The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
listContactReferences_instanceId :: Lens.Lens' ListContactReferences Prelude.Text
listContactReferences_instanceId :: Lens' ListContactReferences Text
listContactReferences_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactReferences' {Text
instanceId :: Text
$sel:instanceId:ListContactReferences' :: ListContactReferences -> Text
instanceId} -> Text
instanceId) (\s :: ListContactReferences
s@ListContactReferences' {} Text
a -> ListContactReferences
s {$sel:instanceId:ListContactReferences' :: Text
instanceId = Text
a} :: ListContactReferences)

-- | The identifier of the initial contact.
listContactReferences_contactId :: Lens.Lens' ListContactReferences Prelude.Text
listContactReferences_contactId :: Lens' ListContactReferences Text
listContactReferences_contactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactReferences' {Text
contactId :: Text
$sel:contactId:ListContactReferences' :: ListContactReferences -> Text
contactId} -> Text
contactId) (\s :: ListContactReferences
s@ListContactReferences' {} Text
a -> ListContactReferences
s {$sel:contactId:ListContactReferences' :: Text
contactId = Text
a} :: ListContactReferences)

-- | The type of reference.
listContactReferences_referenceTypes :: Lens.Lens' ListContactReferences [ReferenceType]
listContactReferences_referenceTypes :: Lens' ListContactReferences [ReferenceType]
listContactReferences_referenceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactReferences' {[ReferenceType]
referenceTypes :: [ReferenceType]
$sel:referenceTypes:ListContactReferences' :: ListContactReferences -> [ReferenceType]
referenceTypes} -> [ReferenceType]
referenceTypes) (\s :: ListContactReferences
s@ListContactReferences' {} [ReferenceType]
a -> ListContactReferences
s {$sel:referenceTypes:ListContactReferences' :: [ReferenceType]
referenceTypes = [ReferenceType]
a} :: ListContactReferences) 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.AWSPager ListContactReferences where
  page :: ListContactReferences
-> AWSResponse ListContactReferences -> Maybe ListContactReferences
page ListContactReferences
rq AWSResponse ListContactReferences
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListContactReferences
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactReferencesResponse (Maybe Text)
listContactReferencesResponse_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 ListContactReferences
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactReferencesResponse (Maybe [ReferenceSummary])
listContactReferencesResponse_referenceSummaryList
            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.$ ListContactReferences
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListContactReferences (Maybe Text)
listContactReferences_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListContactReferences
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactReferencesResponse (Maybe Text)
listContactReferencesResponse_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 ListContactReferences where
  type
    AWSResponse ListContactReferences =
      ListContactReferencesResponse
  request :: (Service -> Service)
-> ListContactReferences -> Request ListContactReferences
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 ListContactReferences
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListContactReferences)))
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 [ReferenceSummary] -> Int -> ListContactReferencesResponse
ListContactReferencesResponse'
            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
"ReferenceSummaryList"
                            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 ListContactReferences where
  hashWithSalt :: Int -> ListContactReferences -> Int
hashWithSalt Int
_salt ListContactReferences' {[ReferenceType]
Maybe Text
Text
referenceTypes :: [ReferenceType]
contactId :: Text
instanceId :: Text
nextToken :: Maybe Text
$sel:referenceTypes:ListContactReferences' :: ListContactReferences -> [ReferenceType]
$sel:contactId:ListContactReferences' :: ListContactReferences -> Text
$sel:instanceId:ListContactReferences' :: ListContactReferences -> Text
$sel:nextToken:ListContactReferences' :: ListContactReferences -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ReferenceType]
referenceTypes

instance Prelude.NFData ListContactReferences where
  rnf :: ListContactReferences -> ()
rnf ListContactReferences' {[ReferenceType]
Maybe Text
Text
referenceTypes :: [ReferenceType]
contactId :: Text
instanceId :: Text
nextToken :: Maybe Text
$sel:referenceTypes:ListContactReferences' :: ListContactReferences -> [ReferenceType]
$sel:contactId:ListContactReferences' :: ListContactReferences -> Text
$sel:instanceId:ListContactReferences' :: ListContactReferences -> Text
$sel:nextToken:ListContactReferences' :: ListContactReferences -> 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 Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ReferenceType]
referenceTypes

instance Data.ToHeaders ListContactReferences where
  toHeaders :: ListContactReferences -> 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 ListContactReferences where
  toPath :: ListContactReferences -> ByteString
toPath ListContactReferences' {[ReferenceType]
Maybe Text
Text
referenceTypes :: [ReferenceType]
contactId :: Text
instanceId :: Text
nextToken :: Maybe Text
$sel:referenceTypes:ListContactReferences' :: ListContactReferences -> [ReferenceType]
$sel:contactId:ListContactReferences' :: ListContactReferences -> Text
$sel:instanceId:ListContactReferences' :: ListContactReferences -> Text
$sel:nextToken:ListContactReferences' :: ListContactReferences -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/contact/references/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
instanceId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
contactId
      ]

instance Data.ToQuery ListContactReferences where
  toQuery :: ListContactReferences -> QueryString
toQuery ListContactReferences' {[ReferenceType]
Maybe Text
Text
referenceTypes :: [ReferenceType]
contactId :: Text
instanceId :: Text
nextToken :: Maybe Text
$sel:referenceTypes:ListContactReferences' :: ListContactReferences -> [ReferenceType]
$sel:contactId:ListContactReferences' :: ListContactReferences -> Text
$sel:instanceId:ListContactReferences' :: ListContactReferences -> Text
$sel:nextToken:ListContactReferences' :: ListContactReferences -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"referenceTypes"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [ReferenceType]
referenceTypes
      ]

-- | /See:/ 'newListContactReferencesResponse' smart constructor.
data ListContactReferencesResponse = ListContactReferencesResponse'
  { -- | If there are additional results, this is the token for the next set of
    -- results.
    --
    -- This is always returned as null in the response.
    ListContactReferencesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the flows.
    ListContactReferencesResponse -> Maybe [ReferenceSummary]
referenceSummaryList :: Prelude.Maybe [ReferenceSummary],
    -- | The response's http status code.
    ListContactReferencesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListContactReferencesResponse
-> ListContactReferencesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContactReferencesResponse
-> ListContactReferencesResponse -> Bool
$c/= :: ListContactReferencesResponse
-> ListContactReferencesResponse -> Bool
== :: ListContactReferencesResponse
-> ListContactReferencesResponse -> Bool
$c== :: ListContactReferencesResponse
-> ListContactReferencesResponse -> Bool
Prelude.Eq, ReadPrec [ListContactReferencesResponse]
ReadPrec ListContactReferencesResponse
Int -> ReadS ListContactReferencesResponse
ReadS [ListContactReferencesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContactReferencesResponse]
$creadListPrec :: ReadPrec [ListContactReferencesResponse]
readPrec :: ReadPrec ListContactReferencesResponse
$creadPrec :: ReadPrec ListContactReferencesResponse
readList :: ReadS [ListContactReferencesResponse]
$creadList :: ReadS [ListContactReferencesResponse]
readsPrec :: Int -> ReadS ListContactReferencesResponse
$creadsPrec :: Int -> ReadS ListContactReferencesResponse
Prelude.Read, Int -> ListContactReferencesResponse -> ShowS
[ListContactReferencesResponse] -> ShowS
ListContactReferencesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContactReferencesResponse] -> ShowS
$cshowList :: [ListContactReferencesResponse] -> ShowS
show :: ListContactReferencesResponse -> String
$cshow :: ListContactReferencesResponse -> String
showsPrec :: Int -> ListContactReferencesResponse -> ShowS
$cshowsPrec :: Int -> ListContactReferencesResponse -> ShowS
Prelude.Show, forall x.
Rep ListContactReferencesResponse x
-> ListContactReferencesResponse
forall x.
ListContactReferencesResponse
-> Rep ListContactReferencesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListContactReferencesResponse x
-> ListContactReferencesResponse
$cfrom :: forall x.
ListContactReferencesResponse
-> Rep ListContactReferencesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListContactReferencesResponse' 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', 'listContactReferencesResponse_nextToken' - If there are additional results, this is the token for the next set of
-- results.
--
-- This is always returned as null in the response.
--
-- 'referenceSummaryList', 'listContactReferencesResponse_referenceSummaryList' - Information about the flows.
--
-- 'httpStatus', 'listContactReferencesResponse_httpStatus' - The response's http status code.
newListContactReferencesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListContactReferencesResponse
newListContactReferencesResponse :: Int -> ListContactReferencesResponse
newListContactReferencesResponse Int
pHttpStatus_ =
  ListContactReferencesResponse'
    { $sel:nextToken:ListContactReferencesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:referenceSummaryList:ListContactReferencesResponse' :: Maybe [ReferenceSummary]
referenceSummaryList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListContactReferencesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If there are additional results, this is the token for the next set of
-- results.
--
-- This is always returned as null in the response.
listContactReferencesResponse_nextToken :: Lens.Lens' ListContactReferencesResponse (Prelude.Maybe Prelude.Text)
listContactReferencesResponse_nextToken :: Lens' ListContactReferencesResponse (Maybe Text)
listContactReferencesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactReferencesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContactReferencesResponse' :: ListContactReferencesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContactReferencesResponse
s@ListContactReferencesResponse' {} Maybe Text
a -> ListContactReferencesResponse
s {$sel:nextToken:ListContactReferencesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListContactReferencesResponse)

-- | Information about the flows.
listContactReferencesResponse_referenceSummaryList :: Lens.Lens' ListContactReferencesResponse (Prelude.Maybe [ReferenceSummary])
listContactReferencesResponse_referenceSummaryList :: Lens' ListContactReferencesResponse (Maybe [ReferenceSummary])
listContactReferencesResponse_referenceSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactReferencesResponse' {Maybe [ReferenceSummary]
referenceSummaryList :: Maybe [ReferenceSummary]
$sel:referenceSummaryList:ListContactReferencesResponse' :: ListContactReferencesResponse -> Maybe [ReferenceSummary]
referenceSummaryList} -> Maybe [ReferenceSummary]
referenceSummaryList) (\s :: ListContactReferencesResponse
s@ListContactReferencesResponse' {} Maybe [ReferenceSummary]
a -> ListContactReferencesResponse
s {$sel:referenceSummaryList:ListContactReferencesResponse' :: Maybe [ReferenceSummary]
referenceSummaryList = Maybe [ReferenceSummary]
a} :: ListContactReferencesResponse) 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.
listContactReferencesResponse_httpStatus :: Lens.Lens' ListContactReferencesResponse Prelude.Int
listContactReferencesResponse_httpStatus :: Lens' ListContactReferencesResponse Int
listContactReferencesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactReferencesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListContactReferencesResponse' :: ListContactReferencesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListContactReferencesResponse
s@ListContactReferencesResponse' {} Int
a -> ListContactReferencesResponse
s {$sel:httpStatus:ListContactReferencesResponse' :: Int
httpStatus = Int
a} :: ListContactReferencesResponse)

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