{-# 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.ListPhoneNumbersV2
-- 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 phone numbers claimed to your Amazon Connect instance or traffic
-- distribution group. If the provided @TargetArn@ is a traffic
-- distribution group, you can call this API in both Amazon Web Services
-- Regions associated with traffic distribution group.
--
-- For more information about phone numbers, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/contact-center-phone-number.html Set Up Phone Numbers for Your Contact Center>
-- in the /Amazon Connect Administrator Guide/.
--
-- This operation returns paginated results.
module Amazonka.Connect.ListPhoneNumbersV2
  ( -- * Creating a Request
    ListPhoneNumbersV2 (..),
    newListPhoneNumbersV2,

    -- * Request Lenses
    listPhoneNumbersV2_maxResults,
    listPhoneNumbersV2_nextToken,
    listPhoneNumbersV2_phoneNumberCountryCodes,
    listPhoneNumbersV2_phoneNumberPrefix,
    listPhoneNumbersV2_phoneNumberTypes,
    listPhoneNumbersV2_targetArn,

    -- * Destructuring the Response
    ListPhoneNumbersV2Response (..),
    newListPhoneNumbersV2Response,

    -- * Response Lenses
    listPhoneNumbersV2Response_listPhoneNumbersSummaryList,
    listPhoneNumbersV2Response_nextToken,
    listPhoneNumbersV2Response_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:/ 'newListPhoneNumbersV2' smart constructor.
data ListPhoneNumbersV2 = ListPhoneNumbersV2'
  { -- | The maximum number of results to return per page.
    ListPhoneNumbersV2 -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | 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.
    ListPhoneNumbersV2 -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ISO country code.
    ListPhoneNumbersV2 -> Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes :: Prelude.Maybe [PhoneNumberCountryCode],
    -- | The prefix of the phone number. If provided, it must contain @+@ as part
    -- of the country code.
    ListPhoneNumbersV2 -> Maybe Text
phoneNumberPrefix :: Prelude.Maybe Prelude.Text,
    -- | The type of phone number.
    ListPhoneNumbersV2 -> Maybe [PhoneNumberType]
phoneNumberTypes :: Prelude.Maybe [PhoneNumberType],
    -- | The Amazon Resource Name (ARN) for Amazon Connect instances or traffic
    -- distribution groups that phone numbers are claimed to. If @TargetArn@
    -- input is not provided, this API lists numbers claimed to all the Amazon
    -- Connect instances belonging to your account in the same Amazon Web
    -- Services Region as the request.
    ListPhoneNumbersV2 -> Maybe Text
targetArn :: Prelude.Maybe Prelude.Text
  }
  deriving (ListPhoneNumbersV2 -> ListPhoneNumbersV2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPhoneNumbersV2 -> ListPhoneNumbersV2 -> Bool
$c/= :: ListPhoneNumbersV2 -> ListPhoneNumbersV2 -> Bool
== :: ListPhoneNumbersV2 -> ListPhoneNumbersV2 -> Bool
$c== :: ListPhoneNumbersV2 -> ListPhoneNumbersV2 -> Bool
Prelude.Eq, ReadPrec [ListPhoneNumbersV2]
ReadPrec ListPhoneNumbersV2
Int -> ReadS ListPhoneNumbersV2
ReadS [ListPhoneNumbersV2]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPhoneNumbersV2]
$creadListPrec :: ReadPrec [ListPhoneNumbersV2]
readPrec :: ReadPrec ListPhoneNumbersV2
$creadPrec :: ReadPrec ListPhoneNumbersV2
readList :: ReadS [ListPhoneNumbersV2]
$creadList :: ReadS [ListPhoneNumbersV2]
readsPrec :: Int -> ReadS ListPhoneNumbersV2
$creadsPrec :: Int -> ReadS ListPhoneNumbersV2
Prelude.Read, Int -> ListPhoneNumbersV2 -> ShowS
[ListPhoneNumbersV2] -> ShowS
ListPhoneNumbersV2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPhoneNumbersV2] -> ShowS
$cshowList :: [ListPhoneNumbersV2] -> ShowS
show :: ListPhoneNumbersV2 -> String
$cshow :: ListPhoneNumbersV2 -> String
showsPrec :: Int -> ListPhoneNumbersV2 -> ShowS
$cshowsPrec :: Int -> ListPhoneNumbersV2 -> ShowS
Prelude.Show, forall x. Rep ListPhoneNumbersV2 x -> ListPhoneNumbersV2
forall x. ListPhoneNumbersV2 -> Rep ListPhoneNumbersV2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPhoneNumbersV2 x -> ListPhoneNumbersV2
$cfrom :: forall x. ListPhoneNumbersV2 -> Rep ListPhoneNumbersV2 x
Prelude.Generic)

-- |
-- Create a value of 'ListPhoneNumbersV2' 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', 'listPhoneNumbersV2_maxResults' - The maximum number of results to return per page.
--
-- 'nextToken', 'listPhoneNumbersV2_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.
--
-- 'phoneNumberCountryCodes', 'listPhoneNumbersV2_phoneNumberCountryCodes' - The ISO country code.
--
-- 'phoneNumberPrefix', 'listPhoneNumbersV2_phoneNumberPrefix' - The prefix of the phone number. If provided, it must contain @+@ as part
-- of the country code.
--
-- 'phoneNumberTypes', 'listPhoneNumbersV2_phoneNumberTypes' - The type of phone number.
--
-- 'targetArn', 'listPhoneNumbersV2_targetArn' - The Amazon Resource Name (ARN) for Amazon Connect instances or traffic
-- distribution groups that phone numbers are claimed to. If @TargetArn@
-- input is not provided, this API lists numbers claimed to all the Amazon
-- Connect instances belonging to your account in the same Amazon Web
-- Services Region as the request.
newListPhoneNumbersV2 ::
  ListPhoneNumbersV2
newListPhoneNumbersV2 :: ListPhoneNumbersV2
newListPhoneNumbersV2 =
  ListPhoneNumbersV2'
    { $sel:maxResults:ListPhoneNumbersV2' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPhoneNumbersV2' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumberCountryCodes:ListPhoneNumbersV2' :: Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumberPrefix:ListPhoneNumbersV2' :: Maybe Text
phoneNumberPrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumberTypes:ListPhoneNumbersV2' :: Maybe [PhoneNumberType]
phoneNumberTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:targetArn:ListPhoneNumbersV2' :: Maybe Text
targetArn = forall a. Maybe a
Prelude.Nothing
    }

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

-- | 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.
listPhoneNumbersV2_nextToken :: Lens.Lens' ListPhoneNumbersV2 (Prelude.Maybe Prelude.Text)
listPhoneNumbersV2_nextToken :: Lens' ListPhoneNumbersV2 (Maybe Text)
listPhoneNumbersV2_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersV2' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPhoneNumbersV2
s@ListPhoneNumbersV2' {} Maybe Text
a -> ListPhoneNumbersV2
s {$sel:nextToken:ListPhoneNumbersV2' :: Maybe Text
nextToken = Maybe Text
a} :: ListPhoneNumbersV2)

-- | The ISO country code.
listPhoneNumbersV2_phoneNumberCountryCodes :: Lens.Lens' ListPhoneNumbersV2 (Prelude.Maybe [PhoneNumberCountryCode])
listPhoneNumbersV2_phoneNumberCountryCodes :: Lens' ListPhoneNumbersV2 (Maybe [PhoneNumberCountryCode])
listPhoneNumbersV2_phoneNumberCountryCodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersV2' {Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes :: Maybe [PhoneNumberCountryCode]
$sel:phoneNumberCountryCodes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes} -> Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes) (\s :: ListPhoneNumbersV2
s@ListPhoneNumbersV2' {} Maybe [PhoneNumberCountryCode]
a -> ListPhoneNumbersV2
s {$sel:phoneNumberCountryCodes:ListPhoneNumbersV2' :: Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes = Maybe [PhoneNumberCountryCode]
a} :: ListPhoneNumbersV2) 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 prefix of the phone number. If provided, it must contain @+@ as part
-- of the country code.
listPhoneNumbersV2_phoneNumberPrefix :: Lens.Lens' ListPhoneNumbersV2 (Prelude.Maybe Prelude.Text)
listPhoneNumbersV2_phoneNumberPrefix :: Lens' ListPhoneNumbersV2 (Maybe Text)
listPhoneNumbersV2_phoneNumberPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersV2' {Maybe Text
phoneNumberPrefix :: Maybe Text
$sel:phoneNumberPrefix:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
phoneNumberPrefix} -> Maybe Text
phoneNumberPrefix) (\s :: ListPhoneNumbersV2
s@ListPhoneNumbersV2' {} Maybe Text
a -> ListPhoneNumbersV2
s {$sel:phoneNumberPrefix:ListPhoneNumbersV2' :: Maybe Text
phoneNumberPrefix = Maybe Text
a} :: ListPhoneNumbersV2)

-- | The type of phone number.
listPhoneNumbersV2_phoneNumberTypes :: Lens.Lens' ListPhoneNumbersV2 (Prelude.Maybe [PhoneNumberType])
listPhoneNumbersV2_phoneNumberTypes :: Lens' ListPhoneNumbersV2 (Maybe [PhoneNumberType])
listPhoneNumbersV2_phoneNumberTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersV2' {Maybe [PhoneNumberType]
phoneNumberTypes :: Maybe [PhoneNumberType]
$sel:phoneNumberTypes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberType]
phoneNumberTypes} -> Maybe [PhoneNumberType]
phoneNumberTypes) (\s :: ListPhoneNumbersV2
s@ListPhoneNumbersV2' {} Maybe [PhoneNumberType]
a -> ListPhoneNumbersV2
s {$sel:phoneNumberTypes:ListPhoneNumbersV2' :: Maybe [PhoneNumberType]
phoneNumberTypes = Maybe [PhoneNumberType]
a} :: ListPhoneNumbersV2) 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 Amazon Resource Name (ARN) for Amazon Connect instances or traffic
-- distribution groups that phone numbers are claimed to. If @TargetArn@
-- input is not provided, this API lists numbers claimed to all the Amazon
-- Connect instances belonging to your account in the same Amazon Web
-- Services Region as the request.
listPhoneNumbersV2_targetArn :: Lens.Lens' ListPhoneNumbersV2 (Prelude.Maybe Prelude.Text)
listPhoneNumbersV2_targetArn :: Lens' ListPhoneNumbersV2 (Maybe Text)
listPhoneNumbersV2_targetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersV2' {Maybe Text
targetArn :: Maybe Text
$sel:targetArn:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
targetArn} -> Maybe Text
targetArn) (\s :: ListPhoneNumbersV2
s@ListPhoneNumbersV2' {} Maybe Text
a -> ListPhoneNumbersV2
s {$sel:targetArn:ListPhoneNumbersV2' :: Maybe Text
targetArn = Maybe Text
a} :: ListPhoneNumbersV2)

instance Core.AWSPager ListPhoneNumbersV2 where
  page :: ListPhoneNumbersV2
-> AWSResponse ListPhoneNumbersV2 -> Maybe ListPhoneNumbersV2
page ListPhoneNumbersV2
rq AWSResponse ListPhoneNumbersV2
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPhoneNumbersV2
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPhoneNumbersV2Response (Maybe Text)
listPhoneNumbersV2Response_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 ListPhoneNumbersV2
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPhoneNumbersV2Response (Maybe [ListPhoneNumbersSummary])
listPhoneNumbersV2Response_listPhoneNumbersSummaryList
            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.$ ListPhoneNumbersV2
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPhoneNumbersV2 (Maybe Text)
listPhoneNumbersV2_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPhoneNumbersV2
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPhoneNumbersV2Response (Maybe Text)
listPhoneNumbersV2Response_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 ListPhoneNumbersV2 where
  type
    AWSResponse ListPhoneNumbersV2 =
      ListPhoneNumbersV2Response
  request :: (Service -> Service)
-> ListPhoneNumbersV2 -> Request ListPhoneNumbersV2
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 ListPhoneNumbersV2
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListPhoneNumbersV2)))
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 [ListPhoneNumbersSummary]
-> Maybe Text -> Int -> ListPhoneNumbersV2Response
ListPhoneNumbersV2Response'
            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
"ListPhoneNumbersSummaryList"
                            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
"NextToken")
            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 ListPhoneNumbersV2 where
  hashWithSalt :: Int -> ListPhoneNumbersV2 -> Int
hashWithSalt Int
_salt ListPhoneNumbersV2' {Maybe Natural
Maybe [PhoneNumberCountryCode]
Maybe [PhoneNumberType]
Maybe Text
targetArn :: Maybe Text
phoneNumberTypes :: Maybe [PhoneNumberType]
phoneNumberPrefix :: Maybe Text
phoneNumberCountryCodes :: Maybe [PhoneNumberCountryCode]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:targetArn:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:phoneNumberTypes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberType]
$sel:phoneNumberPrefix:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:phoneNumberCountryCodes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberCountryCode]
$sel:nextToken:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:maxResults:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> 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` Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
phoneNumberPrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PhoneNumberType]
phoneNumberTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetArn

instance Prelude.NFData ListPhoneNumbersV2 where
  rnf :: ListPhoneNumbersV2 -> ()
rnf ListPhoneNumbersV2' {Maybe Natural
Maybe [PhoneNumberCountryCode]
Maybe [PhoneNumberType]
Maybe Text
targetArn :: Maybe Text
phoneNumberTypes :: Maybe [PhoneNumberType]
phoneNumberPrefix :: Maybe Text
phoneNumberCountryCodes :: Maybe [PhoneNumberCountryCode]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:targetArn:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:phoneNumberTypes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberType]
$sel:phoneNumberPrefix:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:phoneNumberCountryCodes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberCountryCode]
$sel:nextToken:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:maxResults:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> 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 Maybe [PhoneNumberCountryCode]
phoneNumberCountryCodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
phoneNumberPrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PhoneNumberType]
phoneNumberTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetArn

instance Data.ToHeaders ListPhoneNumbersV2 where
  toHeaders :: ListPhoneNumbersV2 -> 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.ToJSON ListPhoneNumbersV2 where
  toJSON :: ListPhoneNumbersV2 -> Value
toJSON ListPhoneNumbersV2' {Maybe Natural
Maybe [PhoneNumberCountryCode]
Maybe [PhoneNumberType]
Maybe Text
targetArn :: Maybe Text
phoneNumberTypes :: Maybe [PhoneNumberType]
phoneNumberPrefix :: Maybe Text
phoneNumberCountryCodes :: Maybe [PhoneNumberCountryCode]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:targetArn:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:phoneNumberTypes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberType]
$sel:phoneNumberPrefix:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:phoneNumberCountryCodes:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe [PhoneNumberCountryCode]
$sel:nextToken:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Text
$sel:maxResults:ListPhoneNumbersV2' :: ListPhoneNumbersV2 -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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
maxResults,
            (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,
            (Key
"PhoneNumberCountryCodes" 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 [PhoneNumberCountryCode]
phoneNumberCountryCodes,
            (Key
"PhoneNumberPrefix" 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
phoneNumberPrefix,
            (Key
"PhoneNumberTypes" 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 [PhoneNumberType]
phoneNumberTypes,
            (Key
"TargetArn" 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
targetArn
          ]
      )

instance Data.ToPath ListPhoneNumbersV2 where
  toPath :: ListPhoneNumbersV2 -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/phone-number/list"

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

-- | /See:/ 'newListPhoneNumbersV2Response' smart constructor.
data ListPhoneNumbersV2Response = ListPhoneNumbersV2Response'
  { -- | Information about phone numbers that have been claimed to your Amazon
    -- Connect instances or traffic distribution groups.
    ListPhoneNumbersV2Response -> Maybe [ListPhoneNumbersSummary]
listPhoneNumbersSummaryList :: Prelude.Maybe [ListPhoneNumbersSummary],
    -- | If there are additional results, this is the token for the next set of
    -- results.
    ListPhoneNumbersV2Response -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListPhoneNumbersV2Response -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPhoneNumbersV2Response -> ListPhoneNumbersV2Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPhoneNumbersV2Response -> ListPhoneNumbersV2Response -> Bool
$c/= :: ListPhoneNumbersV2Response -> ListPhoneNumbersV2Response -> Bool
== :: ListPhoneNumbersV2Response -> ListPhoneNumbersV2Response -> Bool
$c== :: ListPhoneNumbersV2Response -> ListPhoneNumbersV2Response -> Bool
Prelude.Eq, ReadPrec [ListPhoneNumbersV2Response]
ReadPrec ListPhoneNumbersV2Response
Int -> ReadS ListPhoneNumbersV2Response
ReadS [ListPhoneNumbersV2Response]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPhoneNumbersV2Response]
$creadListPrec :: ReadPrec [ListPhoneNumbersV2Response]
readPrec :: ReadPrec ListPhoneNumbersV2Response
$creadPrec :: ReadPrec ListPhoneNumbersV2Response
readList :: ReadS [ListPhoneNumbersV2Response]
$creadList :: ReadS [ListPhoneNumbersV2Response]
readsPrec :: Int -> ReadS ListPhoneNumbersV2Response
$creadsPrec :: Int -> ReadS ListPhoneNumbersV2Response
Prelude.Read, Int -> ListPhoneNumbersV2Response -> ShowS
[ListPhoneNumbersV2Response] -> ShowS
ListPhoneNumbersV2Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPhoneNumbersV2Response] -> ShowS
$cshowList :: [ListPhoneNumbersV2Response] -> ShowS
show :: ListPhoneNumbersV2Response -> String
$cshow :: ListPhoneNumbersV2Response -> String
showsPrec :: Int -> ListPhoneNumbersV2Response -> ShowS
$cshowsPrec :: Int -> ListPhoneNumbersV2Response -> ShowS
Prelude.Show, forall x.
Rep ListPhoneNumbersV2Response x -> ListPhoneNumbersV2Response
forall x.
ListPhoneNumbersV2Response -> Rep ListPhoneNumbersV2Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListPhoneNumbersV2Response x -> ListPhoneNumbersV2Response
$cfrom :: forall x.
ListPhoneNumbersV2Response -> Rep ListPhoneNumbersV2Response x
Prelude.Generic)

-- |
-- Create a value of 'ListPhoneNumbersV2Response' 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:
--
-- 'listPhoneNumbersSummaryList', 'listPhoneNumbersV2Response_listPhoneNumbersSummaryList' - Information about phone numbers that have been claimed to your Amazon
-- Connect instances or traffic distribution groups.
--
-- 'nextToken', 'listPhoneNumbersV2Response_nextToken' - If there are additional results, this is the token for the next set of
-- results.
--
-- 'httpStatus', 'listPhoneNumbersV2Response_httpStatus' - The response's http status code.
newListPhoneNumbersV2Response ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPhoneNumbersV2Response
newListPhoneNumbersV2Response :: Int -> ListPhoneNumbersV2Response
newListPhoneNumbersV2Response Int
pHttpStatus_ =
  ListPhoneNumbersV2Response'
    { $sel:listPhoneNumbersSummaryList:ListPhoneNumbersV2Response' :: Maybe [ListPhoneNumbersSummary]
listPhoneNumbersSummaryList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPhoneNumbersV2Response' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPhoneNumbersV2Response' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about phone numbers that have been claimed to your Amazon
-- Connect instances or traffic distribution groups.
listPhoneNumbersV2Response_listPhoneNumbersSummaryList :: Lens.Lens' ListPhoneNumbersV2Response (Prelude.Maybe [ListPhoneNumbersSummary])
listPhoneNumbersV2Response_listPhoneNumbersSummaryList :: Lens' ListPhoneNumbersV2Response (Maybe [ListPhoneNumbersSummary])
listPhoneNumbersV2Response_listPhoneNumbersSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersV2Response' {Maybe [ListPhoneNumbersSummary]
listPhoneNumbersSummaryList :: Maybe [ListPhoneNumbersSummary]
$sel:listPhoneNumbersSummaryList:ListPhoneNumbersV2Response' :: ListPhoneNumbersV2Response -> Maybe [ListPhoneNumbersSummary]
listPhoneNumbersSummaryList} -> Maybe [ListPhoneNumbersSummary]
listPhoneNumbersSummaryList) (\s :: ListPhoneNumbersV2Response
s@ListPhoneNumbersV2Response' {} Maybe [ListPhoneNumbersSummary]
a -> ListPhoneNumbersV2Response
s {$sel:listPhoneNumbersSummaryList:ListPhoneNumbersV2Response' :: Maybe [ListPhoneNumbersSummary]
listPhoneNumbersSummaryList = Maybe [ListPhoneNumbersSummary]
a} :: ListPhoneNumbersV2Response) 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

-- | If there are additional results, this is the token for the next set of
-- results.
listPhoneNumbersV2Response_nextToken :: Lens.Lens' ListPhoneNumbersV2Response (Prelude.Maybe Prelude.Text)
listPhoneNumbersV2Response_nextToken :: Lens' ListPhoneNumbersV2Response (Maybe Text)
listPhoneNumbersV2Response_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPhoneNumbersV2Response' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPhoneNumbersV2Response' :: ListPhoneNumbersV2Response -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPhoneNumbersV2Response
s@ListPhoneNumbersV2Response' {} Maybe Text
a -> ListPhoneNumbersV2Response
s {$sel:nextToken:ListPhoneNumbersV2Response' :: Maybe Text
nextToken = Maybe Text
a} :: ListPhoneNumbersV2Response)

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

instance Prelude.NFData ListPhoneNumbersV2Response where
  rnf :: ListPhoneNumbersV2Response -> ()
rnf ListPhoneNumbersV2Response' {Int
Maybe [ListPhoneNumbersSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
listPhoneNumbersSummaryList :: Maybe [ListPhoneNumbersSummary]
$sel:httpStatus:ListPhoneNumbersV2Response' :: ListPhoneNumbersV2Response -> Int
$sel:nextToken:ListPhoneNumbersV2Response' :: ListPhoneNumbersV2Response -> Maybe Text
$sel:listPhoneNumbersSummaryList:ListPhoneNumbersV2Response' :: ListPhoneNumbersV2Response -> Maybe [ListPhoneNumbersSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ListPhoneNumbersSummary]
listPhoneNumbersSummaryList
      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 Int
httpStatus